## Programming/math "puzzle" for you, guys

General FreeBASIC programming questions.
bplus
Posts: 56
Joined: May 01, 2017 15:57

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

Moderator,

In case you object to dialect in my first post attempt, I have just managed to work it out in FB:

Code: Select all

Dim i As Integer
Dim test As Integer
Dim As String build
Dim As String neew

for i = 0 to 9999
neew = right("0000" + str(i), 4)
test = InStr(build, neew)
if test = 0 then build = build & neew
next
Print:Print
print len(build)
Sleep 1000
xlucas
Posts: 287
Joined: May 09, 2014 21:19
Location: Argentina

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

Uhm... I can't run the code. It tells me that _itoa is not found. Looks to me like a network-related function. I think I've seen it in the past when I was dealing with sockets. I probably have to include some other file at the top.

The thing is, I'm trying to find a rigorous proof. Pushing with different combinations until a valid string results is a good hint that the conjecture is true, but it's not a valid proof, because for a different n or b this might well not hold true. I have the feeling that this might be solvable by using a recursive mechanism.

From my perspective, it is OK to understand it as a non-numerical problem. The difference between numeric digits and other symbols is that the former have a pre-establish order and convey a combined meaning, that is, 2387 is a number in itself, not just a combination of the four digits. These two things make no difference in this problem. The "base" is simply the number of different symbols. Each combination is just like any other combination and while order may seem to make a difference, it only does if we first established an order by choosing a first code, and a second, and a third.

What I mean is, imagine you had a valid string that's a solution for this problem. Now pick any two different symbols (say 7 and 2). Exchange all 7s with all 2s and voilà, you have another valid solution. What does make a difference is whether you have two identical or non-identical digits. 2222 is just akin to 0000, but they have properties that are different from those of 1234 or 8473 in this problem.
dodicat
Posts: 6645
Joined: Jan 10, 2006 20:30
Location: Scotland

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

For Linux try using

function ULongToBase(N as ulong,_base as byte) as string
dim as zstring * 50 buffer
lltoa(n,@buffer,_base)
return ucase(buffer)
end function

I see that:
declare function lltoa (byval as longint, byval as zstring ptr, byval as long) as zstring ptr is in stdlib.bi (Linux)
srvaldez
Posts: 2482
Joined: Sep 25, 2005 21:54

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

hello xlucas
have you asked this question at the xkcd forum ? http://forums.xkcd.com/index.php
they have some very sharp members, here's an example of the problems they tackle http://clomont.com/how-many-prisoners/
xlucas
Posts: 287
Joined: May 09, 2014 21:19
Location: Argentina

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

Thanks, Dodicat!
¡Señor Valdez! That's a very good, very interesting site. Thank you very much! I was hoping I could get in touch with some math enthusiasts and professionals because I love these problems. Of course, I also love programming, so it'd be nice to give the two focuses.

By the way, guys... I achieved something. Look:

Code: Select all

'Comment to make it instant
#define USEDELAY 1

Sub Plot(n As Short, c As Long)
Dim As Byte x, y

x = n Mod 100
y = n \ 100

Line (6 * x, 6 * y)- Step (5, 5), c, BF
End Sub

Type Triplet
trail As Byte
End Type

Dim triplet(0 To 999) As Triplet
Dim symbolchain As String, seed As Short
Dim code(0 To 9999) As Byte, codesleft As Short = 10000
Dim i As Long, s As String, v As Long, w As Long
Dim t As Double

ScreenRes 800, 600, 32
Width 100, 600 \ 16

'Initialise all triplets. For each, there are 10 codes in which it's
'leading and 10 codes in which it's trailing
For i = 0 To 999
triplet(i).trail = 10
Next i

'Prompt the user for a starting code (seed)
Input "Enter a seeding code: ", seed
seed = Abs(seed Mod 10000)

'Initialise chain with the starting code
symbolchain = Right("000" + Trim(Str(seed)), 4)

'Decrement the values for the first code
triplet(seed Mod 1000).trail -= 1
code(seed) = -1
codesleft -= 1
Plot seed, RGB(200, 200, 200)

Do
s = InKey
If Len(s) Then Exit Do

'Try to append a code at the end
v = ValInt(Right(symbolchain, 3))
For i = 0 To 9      'Try each of the possible codes
w = v * 10 + i   'Each is lead by the v triplet
If code(w) = 0 Then   'Found an unused one
Plot w, RGB(0, 200, 0)
symbolchain &= Trim(Str(i))   'Add to the chain
code(w) = -1   'Mark as used
v = w Mod 1000   'But what's the trailing triplet for it?
triplet(v).trail -= 1   'That one must be decremented too
codesleft -= 1   'One more code has been used
Exit For
End If
Next i

'No more to append on the right. Try on the left
Else
v = ValInt(Left(symbolchain, 3))   'Get chain's leading triplet
If triplet(v).trail Then
For i = 0 To 9      'Try each of the possible codes
w = i * 1000 + v   'Each has the v triplet trailing
If code(w) = 0 Then   'Found an unused one
Plot w, RGB(0, 200, 0)
symbolchain = Trim(Str(i)) & symbolchain   'Add to the chain
code(w) = -1   'Mark as used
triplet(v).trail -= 1   'One less with v trailing
v = w \ 10   'But what's the leading triplet for it?
triplet(v).lead -= 1   'That one must be decremented too
codesleft -= 1   'One more code has been used
Exit For
End If
Next i
Else
'Since there are codes left, there must exist a triplet
'that has been used, but not exhausted. Let's look up
For i = 0 To 999
If triplet(i).trail < 10 And triplet(i).trail > 0 Then
'Found one for trailing. Let's find where the chain
'contains this triplet, cut it there and join it at
'the old ends

v = i
i = InStr(symbolchain, Right("00" + Trim(Str(v)), 3))
s = Mid(symbolchain, i)   'Right part of the string
'For the left part, we need to include the triplet again
symbolchain = Left(symbolchain, i + 2)

'Drop the old first three digits, as they are the same
'as on the other end
symbolchain = Mid(symbolchain, 4)

'Connect the new chain
symbolchain = s & symbolchain

'Mark so that we know we've found one
i = -1
Exit For
End If
Next i

If i <> -1 Then
Print
Print "Stuck!"
Exit Do
End If
End If
End If

#ifdef USEDELAY
t = Timer
Do : Loop Until Timer > t + .001
#endif
Loop Until codesleft = 0

Print "Symbol chain length: "; Len(symbolchain)
'If any of the codes were not present, it'd be shown
For i = 0 To 9999
If InStr(symbolchain, Right("000" + Trim(Str(i)), 4)) = 0 Then Print i
Next i

Open "chain.txt" For Output As 1
Print #1, symbolchain;
Close 1
GetKey

This program I made, apparently, always finds a solution and it can do it virtually instantly! It doesn't do any random guess. By default, it's not instant, because it has a graphical display showing how codes are being grabbed and pushed into the chain. If you comment the definition at the beginning of the code, it'll shoot to maximum speed.

You begin by entering a seed, a starting 4-digit code. The procedure will begin adding codes to the right of the string whenever possible. Once it can't find one that goes on the right, it will continue to the left (usually, by the time one side is exhausted, the other side is as well because of the wonderful symmetry of this problem... which I still don't completely understand, ha, ha). Once there are no more codes that can fit either side, if there are remainin codes, the program will look up a triplet that's been used somewhere in the string at least once, but of which there are still some instances left to insert. It will split the chain at that point and join the other two ends, so that execution can continue to add to the new ends. To do this, because this symmetry also means that whenever you get stuck, both the leading and trailing triplets are identical, it will remove one of the two triplets and instead, will insert a copy of the new leading triplet at the end, so the chain is again ending and starting with the same triplet.

All the codes I have tested end up being resolved. The final chain is written to a file you can check. Looking at the graphic is hypnotising, ha, ha. If you guys find any bug or encounter a seed that ends in a failure, let me know. Of course, the fact that this program always seems to work and it follows a procedure instead of using brute force (notice that it never backs up returning a previously pushed code to the stack) doesn't mean the program constinutes a proof. I have not tested all 10000 seeds and even if I did, I would like a comprehensive demonstration. Besides, I want to prove this for all n and all b.
Posts: 130
Joined: May 28, 2009 20:07

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

"Everything has an (one) end, only the sausage has two"... well done :)

Mutton
counting_pine
Posts: 6221
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

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

bplus wrote:Moderator,

In case you object to dialect in my first post attempt, I have just managed to work it out in FB:

Code: Select all

Dim i As Integer
Dim test As Integer
Dim As String build
Dim As String neew

for i = 0 to 9999
neew = right("0000" + str(i), 4)
test = InStr(build, neew)
if test = 0 then build = build & neew
next
Print:Print
print len(build)
Sleep 1000

Hi bplus,
The moderation is mainly to prevent spam bots posting, so from a moderation perspective we are very lenient on coding standards. :)
There have been some successes in other posts in getting the optimal 10000 codes/10003 key presses. I really like the simplicity of your method though, and it doesn't do too badly!
MrSwiss
Posts: 3577
Joined: Jun 02, 2013 9:27
Location: Switzerland

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

I like it too, it can be made even a little bit *tightened*:

Code: Select all

Dim As Integer  test
Dim As String   build, new_ ' a way to get around keywords (pre-/append a underline char)

For i As UInteger = 0 To 9999
new_ = Right("0000" + Str(i), 4)
test = InStr(build, new_)
If test = 0 Then build += new_    ' works only with 2 x String, otherwise '&=' used
Next

Locate 3, 1 : Print "build lenght: "; Str(Len(build))
Sleep   ' until user does something (keyboard/mouse)
bplus
Posts: 56
Joined: May 01, 2017 15:57

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

Ah, there are my posts! finally, both inserted into places at time I posted but out of context of present day conversation in progress.

I confess it was on impulse to sign up and attempt to enter the conversation. FB is a stretch for my BASIC experience with variable type BASIC Beginner dialects. You guys seem advanced and know each other well, the regulars... So it was a special kind of purgatory I suffered waiting for my posts to be made public.

I want to thank (curse) xlucas for sharing this problem. A harmless little comercial jingle that I found extremely difficult to get out of my head.

Thank you Mr Swiss for the tip.

Thanks for liking it's simplicity and tactfully not calling it excrement. Which I realized when I ran the following code which points to 121 redundant entries and where they are in the build string. 10124 - 121 = 10003 but I don't think you can pull the redundancies out without messing up other key codes.

Anyway the code might be used to illustrate the nature of the beast that this problem contains.

Judging from skim of posts since mine, you have coded a method that does produce a string with the mimimum possible string length = 10003? or even less.

Code: Select all

'4 digit key code string.bas  SmallBASIC 0.12.9 [B+=MGA] 2017-05-01
'I have modified this for 2, 3, and here 4 digit key codes
'comparing these you can see how redundancies get more complicated

b = ""
for i = 0 to 9999
new = right("0000" + str(i), 4)
if !(instr(b, new)) then b = b+new
next
? : ?
? len(b)
? b
?
for i = 0 to 9999
new = right("0000" + str(i), 4)
test = instr(b, new)
if test = 0 then
? "Notice: missing ";new;" in b string."
else
r=0:repeatPlace =""
nextTest = instr(test+1, b, new)
while nextTest
repeatPlace += str(nextTest)+" "
r +=1
test = nextTest
nextTest = instr(test +1, b, new)
wend
if r > 0 then ? new;" repeated ";r;" times at ";repeatPlace : totR += r :
end if
next
? "total repeats = ";totR
pause

And you all can thank (curse) xlucas for motivating me to join FB and post!
xlucas
Posts: 287
Joined: May 09, 2014 21:19
Location: Argentina

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

Thanks for sharing, BPlus! When I first came back to the forum, I thought... "How come I hadn't seen this post?". Then, I understood that it had not been there at the time. I'm happy that you approached the problem without first seeing other people's solutions and attempts, because a problem is better understood after you have tried it alone for some time. Also, that way, the game is more enjoyable :P

I believe your method, though it does not reach an optimal value, is indeed very important as a post here, because it shows what one should have tried first. Yet, none of us thought of this simple idea and all kept on scratching our heads until we found something more complex. The use of logic there is very remarkable.

And well, I still have not truly solved this problem. I just found a method to find one solution straight away out of a seed. I still want my rigorous proof and to extend this to all n and b. And I will surely post more of these puzzles, ha, ha.
bplus
Posts: 56
Joined: May 01, 2017 15:57

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

xlucas, you have the heart of a mathematician, need for rigorous proof and generalizing for any amount of digits and base.

I will definitely stay tuned...
xlucas
Posts: 287
Joined: May 09, 2014 21:19
Location: Argentina

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

I'm resurrecting this super-old thread I had started because I've come across with something very relevant. It turns out the problem I came up does exist and was first approached in the late 19th century, ha, ha. My conjecture is indeed a proved theorem and the concept is called a De Bruijn sequence. Here's the corresponding Wikipedia article on it: https://en.wikipedia.org/wiki/De_Bruijn_sequence.

What I call the base and code length correspond here to the parameters k and n of B and, according to this article, for all combinations of those two, the sequence is optimal in length, meaning it's always possible to find such sequence. Of course a different task is creating a program that actually generates the sequence for any of these combinations, but I'm much more comfortable now knowing this has been worked on in the past. Thanks to everybody who showed interest!
counting_pine
Posts: 6221
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

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

Thanks for your update, xlucas. It's good to know this is a formally studied type of sequence, and there's at least one method of reliably generating them.
I made a version based on the sample Python code on the Wikipedia page. The alphabet and the subsequence length are adjustable as constants:

Code: Select all

const ALPHABET = "abcd"
const K = len(ALPHABET), N = 2

dim shared a(0 to K*N-1) as ubyte

sub de_bruijn(t as integer, p as integer)
if t > N then
if N mod p = 0 then
for j as integer = 1 to p
print mid(ALPHABET, a(j)+1, 1);
next j
end if
else
a(t) = a(t-p)
de_bruijn(t+1, p)
for j as integer = a(t-p)+1 to k-1
a(t) = j
de_bruijn(t+1, t)
next j
end if
end sub

de_bruijn(1, 1)
print

It should be noted that the output is a cyclic sequence, so it wraps around.
This means that for the last (n-1) entries in the sequence, you just have to grab the first (n-1) entries a second time.