1. Coding challenge: Advent of code

Dear thinBasic lovers,

up for a challenge? Friend of mine recommended me the following website, which is kind of programmers "advent calendar". Each day, little coding challenge:

I started it today (you can find me as "Petr Schreiber"), and I am coding it in thinBasic of course.
It would be fun to compare solutions for the problems - it helps to train your brain (and unleash thinBasic potential).

I attach my solutions done so far and will update this post. Join me!

Petr

2. ' Updated MinVersion in example 03, fixed casing in example 01

3. DAY 1 was quite easy
That's my contribution for DAY 2, a little more complex.

You need to register, reach day 2, download input data and save as "02.txt" file in the same directory of your script.

```Uses "console"

PrintL "---DAY 2---"
Dim lCount        As Long
Dim Packs()       As String
Dim nPacks        As Long
Dim lSurface      As Long

nPacks = Parse File APP_SourcePath & "02.txt", Packs, \$CRLF, "x"
For lCount = 1 To nPacks
lSurface += 2 *  Val(Packs(lCount, 1)) * Val(Packs(lCount, 2))
lSurface += 2 *  Val(Packs(lCount, 2)) * Val(Packs(lCount, 3))
lSurface += 2 *  Val(Packs(lCount, 3)) * Val(Packs(lCount, 1))

lSurface += Min( Val(Packs(lCount, 1)) * Val(Packs(lCount, 2)),
Val(Packs(lCount, 2)) * Val(Packs(lCount, 3)),
Val(Packs(lCount, 3)) * Val(Packs(lCount, 1)) )

Next
PrintL "Paper surface:", lSurface
PrintL

Dim lRibbon       As Long
Dim lBow          As Long
For lCount = 1 To nPacks
lRibbon += Min( _
(Val(Packs(lCount, 1)) + Val(Packs(lCount, 2))) * 2,
(Val(Packs(lCount, 2)) + Val(Packs(lCount, 3))) * 2,
(Val(Packs(lCount, 3)) + Val(Packs(lCount, 1))) * 2 )

lBow    += Val(Packs(lCount, 1)) * Val(Packs(lCount, 2)) * Val(Packs(lCount, 3))

Next
PrintL "Ribbon       :", lRibbon
PrintL "Bow          :", lBow
PrintL "Ribbon + Bow :", Format\$(lRibbon + lBow)

WaitKey
```

4. Pretty sure there is an easiest way to solve but ... that's my contribution for DAY 3
I've used a dictionary to save locations of houses already visited.
If location is already present into dictionary, adding the same just update the data value.
At the end dictionary count give the number of unique visited houses.

You need to register, reach day 3, download input data and save as "03.txt" file in the same directory of your script.

```Uses "console"Uses "Dictionary"

PrintL "---DAY 3---"
PrintL "---Part 1---"
Dim lCount        As Long
String  s = Load_File(APP_SourcePath & "03.txt")
Long    x
Long    Y
String  sKey
Long    pDictSanta

pDictSanta = Dictionary_Create(1000000, %TRUE)
sKey = "0,0"
For lCount = 1 To Len(s)
Select Case Mid\$(s, lCount, 1)
Case "^"
y += 1
Case ">"
X += 1
Case "v"
y -= 1
Case "<"
X -= 1
End Select
sKey = Format\$(x) & "," & Format\$(y)
Next

PrintL "Houses visited by Santa:", Dictionary_Count(pDictSanta)
Dictionary_Free(pDictSanta)
PrintL

PrintL "---Part 2---"
Long    xSanta, xRobot
Long    ySanta, yRobot
pDictSanta = Dictionary_Create(1000000, %TRUE)
sKey = "0,0"
For lCount = 1 To Len(s)
If IsOdd(lCount) Then
Select Case Mid\$(s, lCount, 1)
Case "^"
ySanta += 1
Case ">"
xSanta += 1
Case "v"
ySanta -= 1
Case "<"
xSanta -= 1
End Select
sKey = Format\$(xSanta) & "," & Format\$(ySanta)
Else
Select Case Mid\$(s, lCount, 1)
Case "^"
yRobot += 1
Case ">"
xRobot += 1
Case "v"
yRobot -= 1
Case "<"
xRobot -= 1
End Select
sKey = Format\$(xRobot) & "," & Format\$(yRobot)
End If
Next

PrintL "Houses visited by Santa & Santa-Robot:", Dictionary_Count(pDictSanta)
Dictionary_Free(pDictSanta)
PrintL

WaitKey
```

5. Day 4 was quite challenging for thinBasic in terms of TIME needed to find the results.
On my PC Part 2 took almost 5 minutes.
May someone find a clever way to discover the result

```'--------------------------------------------------------------------------------------
Uses "console"

PrintL "---DAY 4---"
PrintL "---Part 1---"
Dim sMD5    As String
Dim lMD5    As Long
Dim sSecret As String = "iwrupvqb"
While LEFT\$(sMD5, 5) <> "00000"
Incr lMD5
sMD5 = MD5(sSecret & lMD5)
Wend
PrintL "First MD5 that starts with 00000"
PrintL "Number to add is:", lMD5
PrintL "Secret & number :", sSecret & lMD5
PrintL "MD5:            :", sMD5

PrintL "---Part 2---"
While LEFT\$(sMD5, 6) <> "000000"
Incr lMD5
sMD5 = MD5(sSecret & lMD5)
Wend
PrintL "First MD5 that starts with 000000"
PrintL "Number to add is:", lMD5
PrintL "Secret & number :", sSecret & lMD5
PrintL "MD5:            :", sMD5
PrintL
WaitKey
```

6. For DAY 5 I've only solution for part 1.
Part 2 I have not yet found a way.

Really well constructed those challenges.

```Uses "console"

Dim lCount    As Long
Dim lChar     As Long
Dim sWords()  As String
Long nWords = Parse File APP_SourcePath & "05.txt", sWords, \$CRLF

Long lCount_vowels
Long lCount_NiceStrings
Long lCount_hastwice
Long lCount_HasSpecial

PrintL "---DAY 5---"
PrintL "---Part 1---"
For lCount = 1 To UBound(sWords)
Reset lCount_vowels
Reset lCount_hastwice
Reset lCount_HasSpecial

lCount_Vowels = Tally(sWords(lCount), Any "aeiou")

For lChar = 1 To Len(sWords(lCount)) - 1
If Asc(sWords(lCount), lChar) = Asc(sWords(lCount), lChar + 1) Then
lCount_hastwice = %TRUE
Exit For
End If
Next

If InStr(sWords(lCount), "ab") Or _
InStr(sWords(lCount), "cd") Or _
InStr(sWords(lCount), "pq") Or _
InStr(sWords(lCount), "xy") Then
lCount_HasSpecial = %TRUE
End If

If lCount_Vowels >= 3 And lCount_hastwice = %TRUE And lCount_HasSpecial = %FALSE Then
lCount_NiceStrings += 1
End If

Next
PrintL "Nice string:", lCount_NiceStrings
PrintL
WaitKey
```

7. Huu,

Day 4 complete (attached to first post), you can check it out for example of using Oxygen, which calls back thinBasic to calculate MD5 hash

Petr

8. Roar! All challenges up to Day 5 done.

Attached to the first post of this thread, the second part of 5 I solved this way:
```Function IsNice(input As String) As Long

Dim pair As String * 2 At 0
Long i, j

Long foundMultiplePairs = FALSE
For i = 1 To Len(input)-1
' -- Floating 2 character sequence
SetAt(pair, StrPtr(input)+(i-1))

' -- Can we find it in whole string at least 2x?
If Tally(input, pair) > 1 Then
foundMultiplePairs = TRUE
Exit For
End If
Next

String letter
Long   position, length

' -- Trying each letter
For i = Asc("a") To Asc("z")
letter = Chr\$(i)

' -- If it is present, with anything in between, then it is nice string...
If Len(RegExpr\$(letter+"."+letter, input, 1, position, length)) Then
Return TRUE
End If
Next

Return FALSE

End Function
```

9. 6 is much easier than previous, updated in first post

10. Ha! Proof that less lines of code do not mean faster code!

In challenge 6, there is lot of operations on arrays.

Have a look at original implementation of TurnOff (perform -=1 operation on all elements in range (x1, y1)-(x2, y2)):
```    Function TurnOff(x1 As Long, y1 As Long, x2 As Long, y2 As Long)
Long x, y

For x = x1 To x2
For y = y1 To y2
Me.diode(x, y) = Max(Me.diode(x, y) - 1, 0)
Next
Next
End Function
```
...and then this one optimized:
```    Function TurnOff(x1 As Long, y1 As Long, x2 As Long, y2 As Long)
String memoryOriginal, memoryNew

Long stripeLength = x2-x1+1                       ' -- How many elements
Long memorySize   = stripeLength * SizeOf(Long)   ' -- How much memory they occupy?

Long linearOverlay(stripeLength) At 0             ' -- Setup virtual overlay
Long resultColumn(stripeLength)                   ' -- Array to receive result

Array Fill addition With -1                       ' -- Filling all elements with -1
Long y
For y = y1 To y2                                  ' -- Going just in one dimension
memoryOriginal = Memory_Get(VarPtr(Me.diode(x1, y)), memorySize)  ' -- Get target memory block
SetAt(linearOverlay, StrPtr(memoryOriginal))

MAT resultColumn() = linearOverlay() + addition()                 ' -- Perform optimized multi-element operation

memoryNew = Memory_Get(VarPtr(resultColumn(1)), memorySize)       ' -- Readback the result
memoryNew = Replace\$(memoryNew, MKL\$(-1), MKL\$(0))                ' -- If we got under 0, replace such elements with 0

Memory_Set(VarPtr(Me.diode(x1, y)), memoryNew)                    ' -- Write the memory back
Next
End Function
```
The second looks way too long, but thanks to saving iterations and memory read/writes, this is at least 14x faster!

I also found a way to use ARRAY functions for TYPE arrays. This function should sum up all values in 2D array:
```    Function GetBrightness()
Long x, y
Long lit
For x = 1 To 1000
For y = 1 To 1000
lit += Me.diode(x, y)
Next
Next

Return lit
End Function
```
...but thanks to linearization and using optimized function, it is again much faster:
```    Function GetBrightness() As Long
Long linearOverlay(1000000) At (VarPtr(Me.diode(1,1)))
Return Array Sum linearOverlay
End Function
```

Petr

Page 1 of 2 12 Last

Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•