Coding challenge: Advent of code

[Petr Schreiber]

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:
http://adventofcode.com/

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

[Petr Schreiber]

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

[ErosOlmi]

DAY 1 was quite easy :onthequiet:
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

[ErosOlmi]

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"
Dictionary_Add(pDictSanta, sKey, sKey)
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)
Dictionary_Add(pDictSanta, sKey, sKey)
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"
Dictionary_Add(pDictSanta, sKey, sKey)
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)
Dictionary_Add(pDictSanta , sKey, sKey)
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)
Dictionary_Add(pDictSanta, sKey, sKey)
End If
Next


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


WaitKey

[ErosOlmi]

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

[ErosOlmi]

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

[Petr Schreiber]

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

[Petr Schreiber]

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

If Not foundMultiplePairs Then Return FALSE

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

[Petr Schreiber]

6 is much easier than previous, updated in first post :)

[Petr Schreiber]

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
Long addition(stripeLength) ' -- Array to be used for adding value

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

[Petr Schreiber]

7 done, 8 done.

The 7 made me crazy, as it seems it is simple, then that it needs to be super generic, but in the end, it is kind of easy :)
Code not yet posted as I would like to perform some cleanup.


Petr