Programming/math "puzzle" for you, guys

General FreeBASIC programming questions.
dodicat
Posts: 6639
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Programming/math "puzzle" for you, guys

Postby dodicat » Apr 15, 2017 23:47

My effort.
Using a systematic sieve (takes about six seconds).
Then
Verify the codes are unique by sorting.

Code: Select all

Sub QuickSort(array() As string,begin As long,Finish As long)
    Dim As long i=begin,j=finish
    Dim As string x =array(((I+J)\2))
    While  I <= J
        While array(I) < X
            I+=1
        Wend
        While array(J) > X
            J-=1
        Wend
        If I<=J Then
            Swap array(I),array(J)
            I+=1
            J-=1
        End If
    Wend
    If J > begin Then QuickSort(array(),begin,J)
    If I < Finish Then QuickSort(array(),I,Finish)
End Sub

Sub inc(s As String)
    Dim As Integer counts
    Var ls=Len(s)
    Do
        If  s[ls-counts-1]=57 Then
            counts=counts+1
            If counts=ls Then s="1"+String(ls,"0"):Exit Do
        Else
            s=Left(s,ls-counts-1)+Str(s[ls-counts-1]-47)+String(counts,"0")
            Exit Do
        End If
    Loop
End Sub

function seive(a() as string,s as string,res() as string) as string
    static as long idx
    idx+=1
    for n as long =0 to 9999
        if a(n)<>"a" then
        if mid(a(n),1,3)=s then
            res(idx-1)=a(n)
            function= a(n)
            a(n)="a"
            exit function
        end if
        end if
    next n
    beep
    end function

dim as string s="0000"
dim as string a(0 to 10000),res(0 to 10000)
a(0)=s
dim as long counter
do
     counter+=1
    inc(s)
    a(counter)=s
loop until s="9999"
print "Please wait about six seconds"
 var st=mid(a(9999),2,3),t=""
for n as long=0 to 9999
   t= seive(a(),st,res())
   st=mid(t,2,3)
next n

for n as long=0 to 9999
    print res(n);" ";
next
print
print "Press a key to see the pressed digits"
sleep
dim as string p
for n as long=0 to 9999
    p+=right(res(n),1)
next
print
print "presses"
print p
print "press a key to verify all four digit codes"
sleep
print
print
print "___________________________"
quicksort(res(),0,9999)
for n as long=0 to 9999
    print res(n);" ";
    if n<>valint(res(n)) then print "ERROR",n,res(n):sleep
next



sleep

 

9999 is presumed to be initially set.
Tourist Trap
Posts: 2901
Joined: Jun 02, 2015 16:24

Re: Programming/math "puzzle" for you, guys

Postby Tourist Trap » Apr 16, 2017 11:13

Ok, I don't understand the algorithms you are being implementing folk, but you could plug it in the vizualizer now , via an external sub that is defined at the end of the code:

Code: Select all

 '--------------------------------------------------------
'run over code combinations of the form a0a1..an, ai=0..9
'--------------------------------------------------------

#include once "fbgfx.bi"

randomize TIMER


dim as integer   scrW => any
dim as integer   scrH => any
scope
   var dskW   => -1
   var dskH   => -1
   screenControl   fb.GET_DESKTOP_SIZE, _
               dskW, _
               dskH
   '
   scrW   = dskW - 2*dskW\32
   scrH   = dskH - 2*dskH\8
   screenRes   scrW, scrH, _                        'sets application screen dimension
            32, _                               'sets application screen color depth
            2, _                               'sets application screen page number
            fb.GFX_SHAPED_WINDOW   + _               'enables application standard transparency
            fb.GFX_ALPHA_PRIMITIVES   + _               'enables application standard alpha
            fb.GFX_NO_FRAME                        'sets application borders to none
end scope


type GENERATORPROCTYPE   as sub(() as integer, () as integer)

type COMBINATION
   declare constructor()
   declare constructor(byval CodeLength as integer)
   declare operator cast() as string
   declare property Value() as integer
   declare sub PlugGenerator(byval GeneratorPtr as GENERATORPROCTYPE)
   declare sub Generate(byval Seed as integer=0)
   declare sub PrintCombinationStringInfo()
   declare sub RenderAsBarPlot()
      as integer                  _a(any)
      as integer                  _rankOfGeneration
   static as GENERATORPROCTYPE         _generator
   static as integer               frequency(any)
   static as integer               codeLength
   static as integer               generationCounter
   static as fb.IMAGE ptr            renderedImagePtr
   static as COMBINATION ptr         arrayOfGeneratedCombinationPtr(any)
end type

dim as GENERATORPROCTYPE   COMBINATION._generator   => 0
dim as integer            COMBINATION.frequency(any)
dim as integer            COMBINATION.codeLength            => 0
dim as integer            COMBINATION.generationCounter      => 0
dim as fb.IMAGE ptr         COMBINATION.renderedImagePtr      => 0
dim as COMBINATION ptr      COMBINATION.arrayOfGeneratedCombinationPtr(any)

constructor COMBINATION()
   'note:
   'when a combination is constructed it is not yet generated, generation_rank==-1
   'when a combination is generated,
   'it keeps its first attributed generation_rank - unless it is reinitialized by the constructor
   '
   THIS._rankOfGeneration   => -1
   '
   if COMBINATION.codeLength<1 then
      COMBINATION.codeLength   => 1
   end if
   redim THIS._a(COMBINATION.codeLength - 1)
   redim preserve   COMBINATION.frequency(10^COMBINATION.codeLength - 1)
end constructor
constructor COMBINATION(byval CodeLengthArg as integer)
   THIS._rankOfGeneration   => -1
   if CodeLengthArg<1 then
      CodeLengthArg = 1
   end if
   COMBINATION.codeLength   = CodeLengthArg
   redim THIS._a(COMBINATION.codeLength - 1)
   redim preserve   COMBINATION.frequency(10^COMBINATION.codeLength - 1)
end constructor
operator COMBINATION.cast() as string
   dim as string   castValue   => ""
   for arrayIndex as integer = lBound(THIS._a) to _
                        uBound(THIS._a)
      castValue   &= str(THIS._a(arrayIndex))
   next arrayIndex
   '
   return castValue
end operator
property COMBINATION.Value() as integer
   dim as integer   returnValue   => -1
   dim as integer   sum         => 0
   for arrayIndex as integer =   0 to COMBINATION.codeLength - 1
      sum   += THIS._a(COMBINATION.codeLength - 1 - arrayIndex)*10^arrayIndex
      if arrayIndex=(COMBINATION.codeLength - 1) then
         returnValue   = sum
      end if
   next arrayIndex
   '
   return returnValue
end property
sub COMBINATION.PlugGenerator(byval GeneratorPtr as GENERATORPROCTYPE)
   COMBINATION._generator   = GeneratorPtr
end sub
sub COMBINATION.Generate(byval Seed as integer=0)
   if THIS._rankOfGeneration=-1 then
      COMBINATION.generationCounter   += 1
      THIS._rankOfGeneration         = COMBINATION.generationCounter
      redim preserve _
      COMBINATION.arrayOfGeneratedCombinationPtr(uBound(COMBINATION.arrayOfGeneratedCombinationPtr) + 1)
      COMBINATION.arrayOfGeneratedCombinationPtr(uBound(COMBINATION.arrayOfGeneratedCombinationPtr))   = @THIS
   end if
   '
   if THIS._generator=0 then
      if uBound(COMBINATION.arrayOfGeneratedCombinationPtr)>1 then
         for arrayIndex as integer = 0 to uBound(THIS._a) - 1   
            THIS._a(arrayIndex)   = _
            COMBINATION.arrayOfGeneratedCombinationPtr(uBound(COMBINATION.arrayOfGeneratedCombinationPtr) - 1)-> _
            _a(arrayIndex + 1)
         next arrayIndex
         THIS._a(uBound(THIS._a))   = int(rnd()*10)
      else
         for arrayIndex as integer = 0 to uBound(THIS._a)
            THIS._a(arrayIndex)   = valInt(   _
                                    mid(   str(Seed), _
                                          uBound(THIS._a) - arrayIndex + 1, _
                                          1 _
                                          ) _
                                    )
         next arrayIndex
      end if
   else
      if uBound(COMBINATION.arrayOfGeneratedCombinationPtr)>1 then
         (COMBINATION._generator)(   COMBINATION.arrayOfGeneratedCombinationPtr(THIS._rankOfGeneration - 2)->_a(), _
                              THIS._a()   _
                              )
      end if
   end if
   '
   COMBINATION.frequency(THIS.Value) += 1
end sub
sub COMBINATION.PrintCombinationStringInfo()
   ? THIS
end sub
sub COMBINATION.RenderAsBarPlot()
   dim as integer   scrW, scrH
   screenControl   fb.GET_SCREEN_SIZE, _
               scrW, _
               scrH
   '
   view    (10, 10)-(scrW -1 - 10, scrH - 1 - 10), _
         rgb(220,250,200), _
         rgb(100,100,200)
      line (0,scrH - 135)-step(scrW -1 - 20,20), rgb(100,200,100), bf
       if COMBINATION.renderedImagePtr<>0 then
           put (0,0), COMBINATION.renderedImagePtr, TRANS
       end if
       imageDestroy   COMBINATION.renderedImagePtr
       COMBINATION.renderedImagePtr   = imageCreate(scrW - 20, scrH - 20, rgb(255,0,255), 32)
   window    (0,0)-(10^COMBINATION.codeLength - 1, 40)
      line   (THIS.Value, 0)-step(1, COMBINATION.frequency(THIS.Value)), _
            rgba(180,100,120, 100), _
            bf
   window screen
   view screen
    get (10, 10)-(scrW -1 - 10, scrH - 1 - 10), COMBINATION.renderedImagePtr
   view    (10, 10)-(scrW -1 - 10, scrH - 1 - 10), _
         rgb(220,220,180), _
         rgb(100,100,200)
      put (0,0), COMBINATION.renderedImagePtr, TRANS
   window    (0,0)-(10^COMBINATION.codeLength - 1, 40)
       draw string (THIS.Value, 10), str(THIS.Value)
   window screen
   view screen
end sub


declare sub UserGenerator(() as integer, () as integer)


'-----------------------------------------------------------------------------------------MAIN
redim as COMBINATION      arrayOfComb(0)
arrayOfComb(0)   => COMBINATION(3)
arrayOfComb(0).PlugGenerator(@UserGenerator)
arrayOfComb(0).Generate()


var hasFoundSomeUnknownCombination   => FALSE
var lastMinZeroPosition            => 0
do
   screenSet 1, 0
      redim preserve   arrayOfComb(uBound(arrayOfComb) + 1)
      arrayOfComb(uBound(arrayOfComb)).Generate(1)
      'comment/uncomment to toogle text/graphics:
         'arrayOfComb(uBound(arrayOfComb)).PrintCombinationStringInfo()
         arrayOfComb(uBound(arrayOfComb)).RenderAsBarPlot()
   screenCopy 1, 0
   '
   'test if the whole combinations have been found
   hasFoundSomeUnknownCombination   = FALSE
   for frequencyArrayIndex as integer = lastMinZeroPosition to uBound(COMBINATION.frequency)
      if COMBINATION.frequency(frequencyArrayIndex)=0 then
         lastMinZeroPosition            = frequencyArrayIndex
         hasFoundSomeUnknownCombination   = TRUE
         exit for
      end if
   next frequencyArrayIndex
   '
   sleep 10
loop until ( inkey()=chr(27) orElse (not hasFoundSomeUnknownCombination) )


color ,rgb(200,0,0)
? COMBINATION.generationCounter
screenCopy 1, 0

'---------------------------------------------------------------------------------------------
getKey()


'------------------------------------------------------------------------------------------SUB
sub UserGenerator(Pre() as integer, Nex() as integer)
   'reuse of the last digits of the previously generated code:
   for codeArrayIndex as integer = lBound(Pre) to uBound(Pre) - 1
      Nex(codeArrayIndex) = Pre(codeArrayIndex + 1)   
   next codeArrayIndex
   '
   'set now a new digit at the last position of the new code:
   static as integer   i                                    'put your algorithm here
   i += 1                                                '
   Nex(uBound(Pre)) = (1000*rnd()*(i mod (10 - (1 + rnd()*8))) mod 10)   '
end sub


'(eof)

I have seen here and there some MOD operator so I've implemented a dummy example to show where the algorithm goes. I hope it is understandable.
dodicat
Posts: 6639
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Programming/math "puzzle" for you, guys

Postby dodicat » Apr 16, 2017 12:36

Hi TT.
My algorithm is very easy.
The last three digits of a four digit combination will be the first three digits of the next.
So, just search through all the values in the array (0000 to 9999), a(), to find one that fits this criterion.
When one is found, record it in an array (res()), and destroy this element in the 0000 to 9999 array, (make it ="a"), so it cannot be used again.
The maximum number of presses will be 40000, i.e. 0000 0001 0002 ... ....
The minimum number will be 10000, because at least one press must be done to change the combination, and there are 10000 combinations.

It just so happens that this minimum suffices to do the job.
It takes a few seconds because of the string functions MID() being called so many times.
Tourist Trap
Posts: 2901
Joined: Jun 02, 2015 16:24

Re: Programming/math "puzzle" for you, guys

Postby Tourist Trap » Apr 16, 2017 16:19

dodicat wrote:Hi TT.
My algorithm is very easy.

It just so happens that this minimum suffices to do the job.

Oh ok, this is quite intuitive. It's probably how one would proceed by hand.

Do you count the number of research aborted when you say that 10.000 is just sufficient. I mean, suppose you have 123, then you may try 1231 but fell on something already tried before, then try 1232 and so on. Or does it always find the right next number just by design?
dodicat
Posts: 6639
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Programming/math "puzzle" for you, guys

Postby dodicat » Apr 16, 2017 16:34

It always gets a result.
I put a beep in the sieve function.
You can call the sieve function more than 10000 times, but all the elements of a() will be "a", and it will beep.
The starting value of 9999 insures a clean transfer of values from a() into res().

Provoni's method is cleverer than mine and surprisingly fast.

My method is just a non mathematical slog, it is like emptying one barrow of crap into another.
Tourist Trap
Posts: 2901
Joined: Jun 02, 2015 16:24

Re: Programming/math "puzzle" for you, guys

Postby Tourist Trap » Apr 16, 2017 19:06

dodicat wrote:My method is just a non mathematical slog, it is like emptying one barrow of crap into another.

I find all those methods pretty, and more, I'm still puzzled to see that we can walk by all the code combinations in one single flow.
I had been equipped with a code machine like this in the past, but it contained also A and B letters, so that maybe it's a base 12 affair. Does it still work?
xlucas
Posts: 285
Joined: May 09, 2014 21:19
Location: Argentina

Re: Programming/math "puzzle" for you, guys

Postby xlucas » Apr 18, 2017 2:22

Hey, guys. I've been reading your examples more carefully. I can see that our programming styles are very different and it's a little hard for each of us to understand code written by the others, ha, ha... but still, we all more or less tried to do the same thing. I have some observations:

- I am surprised that my code did not always find a good next even though I did basically the same thing you guys did. I just start with 0000 and always look for a number that given ABCD will have the form BCDx and has not yet been used, testing first x=0 and going up to x=9. Doing this, I failed three times, which resulted in 10006 key presses (the first three keys give no codes and the other 3 extra keys are the failed attempts, which I "solved" by just inserting a "9").
- Also, I am surprised that 10003 keys are enough, even though I see they clearly are, because of the problem I had described at the beginning: for every triplet ABC, there exist exactly 20 combinations containing it. 10 of the form xABC (where x is any digit) and 10 of the form ABCx. I assumed that a perfect ordering would necessarily result in these combinations to be paired so that there would be 10 instances of the triplet in the string of key presses. For each instance, you would have xABCy being x and y the previous and next digits in the string and this 5-tuplet would contain the two combinations xABC and ABCy. Because the first ABC at the beginning of the string has no x and the last ABC at the end of the string has no y, my guess was that these should be the same ABC, which would be unpaired, adding extra 3 bytes to the string. But clearly, this isn't so. I suspect it has to do with the fact that x and y could well be A or C so something like ABCABC will happen somewhere in the string, that is, ABCA and CABC may not clearly pair. Is this reasoning clear at all? :P
- My guess is that the theoretical minimum can always be achieved for every even base and every number of digits and that for odd bases, it may also work, but I have greater doubts. Of course... this is a guess. I am currently breaking my head trying to actually prove that what we have been doing here can always be done and why.
dodicat
Posts: 6639
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Programming/math "puzzle" for you, guys

Postby dodicat » Apr 18, 2017 9:38

Xlucas
In your buffer you have 0009 , 0099 and 0999 twice:
Here is the beginning of your buffer showing the 0009 repeat.
The others are further down.

Code: Select all

0001 0010 0100 1000 0002 0020 0200 2000 0003 0030 0300 3000 0004 0040 0400 4000 0005 0050 0500 5000 0006 0060 0600 6000
0007 0070 0700 7000 0008 0080 0800 8000 0009 0090 0900 9000 0009 0091 0910 9100 1001 0011 0110 1100 1002 0021 0210 2100
1003 0031 0310 3100 1004 0041 0410 4100 1005 0051 0510 5100 1006 0061 0610 6100 1007 0071 0710 7100 1008 0081 0810 8100
1009 0092 0920 9200 2001 0012 0120 1200 2002 0022 0220 2200 2003 0032 0320 3200 2004 0042 0420 4200 2005 0052 0520 5200
dodicat
Posts: 6639
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Programming/math "puzzle" for you, guys

Postby dodicat » Apr 18, 2017 11:10

Xlucas :Here is your code with a small alteration.
I have saved your buffer in an array, sorted the array and checked for any inconsistencies.
(The buffer is printed out and the sorted buffer is printed out)

Code: Select all

Dim passcode(0 To 9999) As Byte, buffer As String
Dim i As Long, aux As Long, newpass As Long, keyspressed As Long,counter as long
Dim passcodes As Long

buffer = "0000"
keyspressed = 4
dim as string s(0 to 9999)  'string array to hold buffer codes.
s(0)=buffer

'sort to check
declare Sub QuickSort(array() As string,begin As long,Finish As long)

Do
   aux = ValInt(buffer)
   If passcode(aux) = 0 Then passcode(aux) = -1 : passcodes += 1
   
  ' Locate , 1
  ' Print "Pressed: "; keyspressed; " - Codes: "; passcodes;
   
   If aux = 9999 Then Exit Do
   
   For i = 0 To 9
      newpass = 10 * (aux Mod 1000) + i
      If passcode(newpass) = 0 Then Exit For
   Next i
 
   If i > 9 Then
      buffer = Mid(buffer, 3) + "91"    ' ALTERATIOIN HERE!
   Else
      buffer = Mid(buffer, 2) + Trim(Str(i))
   End If
 
   keyspressed += 1
   print buffer;" ";
   counter+=1
   s(counter)=buffer
   
Loop
print
print "________________"
Print
 Print "Pressed: "; keyspressed; " - Codes: "; passcodes;

print
print"Press a key to verify codes"
sleep

quicksort(s(),lbound(s),ubound(s))

for n as long=lbound(s) to ubound(s)
    print s(n);" ";
    if n<>valint(s(n)) then print "ERROR",n,s(n):sleep
next
print
sleep

GetKey

Sub QuickSort(array() As string,begin As long,Finish As long)
    Dim As long i=begin,j=finish
    Dim As string x =array(((I+J)\2))
    While  I <= J
        While array(I) < X
            I+=1
        Wend
        While array(J) > X
            J-=1
        Wend
        If I<=J Then
            Swap array(I),array(J)
            I+=1
            J-=1
        End If
    Wend
    If J > begin Then QuickSort(array(),begin,J)
    If I < Finish Then QuickSort(array(),I,Finish)
End Sub

 
Provoni
Posts: 380
Joined: Jan 05, 2014 12:33
Location: Belgium

Re: Programming/math "puzzle" for you, guys

Postby Provoni » Apr 18, 2017 11:15

Think outside of numbers and bases and just consider them symbols or whatever and suppose "12321" with 3 symbol entries per element.

Code: Select all

12321

into:

123
232
321

into connector frequencies:

12
23 23
32 32
   21

Then, a simple proof or conjecture:

For any set of elements, if there is a 1 to 1 mapping between prefix and suffix connector frequencies (excluding the start and end parts) it must be possible somehow to connect the elements together without exceeding the minimum.

Not sure how that translates to number bases but you could simply check if the frequencies match.
dodicat
Posts: 6639
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Programming/math "puzzle" for you, guys

Postby dodicat » Apr 18, 2017 12:00

The one to one also seems to hold for a two digit press.

i.e.

7711 1178 7811 1179 7911 1180 8011 1181 8111 1182 8211 1183 ...

So it holds for
3+1
2+2


two digit one to one:

Code: Select all

Sub QuickSort(array() As string,begin As long,Finish As long)
    Dim As long i=begin,j=finish
    Dim As string x =array(((I+J)\2))
    While  I <= J
        While array(I) < X
            I+=1
        Wend
        While array(J) > X
            J-=1
        Wend
        If I<=J Then
            Swap array(I),array(J)
            I+=1
            J-=1
        End If
    Wend
    If J > begin Then QuickSort(array(),begin,J)
    If I < Finish Then QuickSort(array(),I,Finish)
End Sub

Sub inc(s As String)
    Dim As Integer counts
    Var ls=Len(s)
    Do
        If  s[ls-counts-1]=57 Then
            counts=counts+1
            If counts=ls Then s="1"+String(ls,"0"):Exit Do
        Else
            s=Left(s,ls-counts-1)+Str(s[ls-counts-1]-47)+String(counts,"0")
            Exit Do
        End If
    Loop
End Sub

function seive(a() as string,s as string,res() as string) as string
    static as long idx
    idx+=1
    for n as long =0 to 9999
        if a(n)<>"a" then
        if mid(a(n),1,2)=s then 'if first two digits = last two digits
            res(idx-1)=a(n)
            function= a(n)
            a(n)="a"
            exit function
        end if
        end if
    next n
    'beep
    end function

dim as string s="0000"
dim as string a(0 to 10000),res(0 to 10000)
a(0)=s
dim as long counter
do
     counter+=1
    inc(s)
    a(counter)=s
loop until s="9999"
print "Please wait about six seconds"
 var st=mid(a(9999),3,2),t=""
for n as long=0 to 9999
   t= seive(a(),st,res())
   st=mid(t,3,2) 'last two digits
next n

for n as long=0 to 9999
    print res(n);" ";
next
print
print "Press a key to see the pressed digits"
sleep
dim as string p
for n as long=0 to 9999
    p+=right(res(n),1)
next
print
print "presses"
print p
print "press a key to verify all four digit codes"
sleep
print
print
print "___________________________"
quicksort(res(),0,9999)
for n as long=0 to 9999
    print res(n);" ";
    if n<>valint(res(n)) then print "ERROR",n,res(n):sleep
next



sleep

 


NOTE: It is said that programming in BASIC ruins you for programming in another language.
I would also put forward that programming in general ruins you for mathematical analyses.
For instance saying
x=x+1
would be frowned upon in any mathematical circle, and any further conjectures made would be dismissed as gibberish.
dodicat
Posts: 6639
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Programming/math "puzzle" for you, guys

Postby dodicat » Apr 18, 2017 12:53

Conjecture
Take any four digits. unique or not.

create the permutations of these four digits.
There are 24 permutations (for unique example).
Any three consecutive digits occur twice in the permutations, and they appear as a cyclic order.
e.g.
4123
1234

so, every permutation has only one cyclic friend
( friends defined as having the first three digits of one = to the last three digits of the other)

Code: Select all


Sub Permutate(s As String,perm() as string,OptionalStop as string="")
    Dim As Integer p,i,j,result
    Dim As String s2=s
    Redim perm(0)
    For p1 As Integer =0 To Len(s2)-2
        For p2 As Integer =p1 + 1 To Len(s2)-1
            If s2[p1]>s2[p2] Then Swap s2[p1],s2[p2]
        Next p2
    Next p1
    Do
        p=p+1
        redim preserve perm(1 to p)
        perm(p)=s2
        if s2=OptionalStop then goto skip
        Do
            For i=Len(s2)-2 To 0 Step -1
                If s2[i] <s2[i+1] Then Exit For
            Next
            If i <0 Then Result=0:Exit Do
            j =Len(s2)-1
            While s2[j] <= s2[i]: j -=1 : Wend
            Swap s2[i], s2[j]
            i +=1
            j =Len(s2)-1
            While i <j
                Swap s2[i], s2[j]
                i +=1
                j -=1
            Wend
            result=-1:Exit Do
        Loop
    Loop Until result=0
    skip:
    Redim Preserve perm(1 To p)
End Sub
redim as string p()


permutate("1234",p())
print "All permuations"
for n as long=lbound(p) to ubound(p)
    print p(n)
next
print
print
print "Cyclic Pairs"
for n1 as long=lbound(p) to ubound(p)
    for n2 as long=lbound(p) to ubound(p)
      if mid(p(n1),1,3)=mid(p(n2),2,3) then print p(n2),p(n1) 
    next
    next
sleep
 

So any four digits will have only one cyclic friend
( friends defined as having the first three digits of one = to the last three digits of the other)

So 10000 one to one relationships exist in 10000 four digit numbers (or characters)
xlucas
Posts: 285
Joined: May 09, 2014 21:19
Location: Argentina

Re: Programming/math "puzzle" for you, guys

Postby xlucas » Apr 19, 2017 5:21

Mmm... let me see if I understood... and if I did, then the whole thing is incredibly simple. What you guys are saying is that:

Since every four digit number of the form xBCD has to be followed by a number of the form BCDy and there are just as many numbers of the first form as those of the second form, then all we have to do is just make sure they are placed one next to the other and we'll always have an optimal result.

Having said that... it sounds so clear I can't believe I had not seen it before. And of course, this must be true for any base and any number of digits because if b is the base, then both x and y can be any of b different symbols, so the number of codes of the first form will still be the same as the number of codes of the second form. Also, it looks like there should be a huge number of different ways of sorting the codes so that the result is still optimal. And just like you guys pointed out, a "symbol" could be one digit or more than one digit and we'd still have the same kind of problem and still be able to solve it.

About how programming ruins math... ha, ha.... I think programming is a way of expressing math so that time is taken into account. Normally, the concept of time exists in physics, but not in pure math. However, it does make sense to introduce time into logic and math, because it tells us about the direction of causation and/or implication. If I write x = x + 1, what I mean is x (future) = x + 1 (past) or x + 1 to imply new x. Granted that the syntax of classical math is a lot more formal and respectful of the meaning of objects, whereas that of programming has been designed by people a lot less concerned about that. Attempts have been made in some programming languages to be more respectful of those thing, but the result has been mostly very confusing for programmers. I hope there's still a chance of conciliating math with programming in a way natural and comfortable to both programmers and mathematicians.
xlucas
Posts: 285
Joined: May 09, 2014 21:19
Location: Argentina

Re: Programming/math "puzzle" for you, guys

Postby xlucas » Apr 19, 2017 5:31

Oh! One thing!!!
Dodicat:
In your modifications to my code, there is one problem. I used to insert a "9" when I got stuck. You replaced this with inserting "91". Although you do get every code once this way, you are actually entering more than 10003 keys because you're typing "91" (two keys), but then computing only one key. That is, there is an extra code you're not seeing.

Say the last code was 1234. Then I would enter a 9 and get 2349, which would be repeated. After that, I would have to find a number of the form 349x, which I would find and it'd be OK. What you do is add 91, so you get 3491, which is not repeated, true, but 2349 is and it's still ocurring, only you're not computing it.
Muttonhead
Posts: 130
Joined: May 28, 2009 20:07

Re: Programming/math "puzzle" for you, guys

Postby Muttonhead » Apr 19, 2017 17:39

... whats now the lowest count of pressed keys?

Mutton

Return to “General”

Who is online

Users browsing this forum: No registered users and 10 guests