Page 1 of 2 12 LastLast
Results 1 to 10 of 11

Thread: Coding challenge: Advent of code

  1. #1
    Super Moderator Petr Schreiber's Avatar
    Join Date
    Aug 2005
    Location
    Brno - Czech Republic
    Posts
    7,128
    Rep Power
    732

    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:
    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
    Attached Files Attached Files
    Last edited by Petr Schreiber; 06-12-2015 at 10:39.
    Learn 3D graphics with ThinBASIC, learn TBGL!
    Windows 10 64bit - Intel Core i5-3350P @ 3.1GHz - 16 GB RAM - NVIDIA GeForce GTX 1050 Ti 4GB

  2. #2
    Super Moderator Petr Schreiber's Avatar
    Join Date
    Aug 2005
    Location
    Brno - Czech Republic
    Posts
    7,128
    Rep Power
    732
    ' Updated MinVersion in example 03, fixed casing in example 01
    Learn 3D graphics with ThinBASIC, learn TBGL!
    Windows 10 64bit - Intel Core i5-3350P @ 3.1GHz - 16 GB RAM - NVIDIA GeForce GTX 1050 Ti 4GB

  3. #3
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,777
    Rep Power
    10
    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
    
    Last edited by ErosOlmi; 05-12-2015 at 22:09.
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

  4. #4
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,777
    Rep Power
    10
    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
    
    Last edited by ErosOlmi; 05-12-2015 at 23:13.
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

  5. #5
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,777
    Rep Power
    10
    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
    
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

  6. #6
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,777
    Rep Power
    10
    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
    
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

  7. #7
    Super Moderator Petr Schreiber's Avatar
    Join Date
    Aug 2005
    Location
    Brno - Czech Republic
    Posts
    7,128
    Rep Power
    732
    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
    Learn 3D graphics with ThinBASIC, learn TBGL!
    Windows 10 64bit - Intel Core i5-3350P @ 3.1GHz - 16 GB RAM - NVIDIA GeForce GTX 1050 Ti 4GB

  8. #8
    Super Moderator Petr Schreiber's Avatar
    Join Date
    Aug 2005
    Location
    Brno - Czech Republic
    Posts
    7,128
    Rep Power
    732
    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
    
    Learn 3D graphics with ThinBASIC, learn TBGL!
    Windows 10 64bit - Intel Core i5-3350P @ 3.1GHz - 16 GB RAM - NVIDIA GeForce GTX 1050 Ti 4GB

  9. #9
    Super Moderator Petr Schreiber's Avatar
    Join Date
    Aug 2005
    Location
    Brno - Czech Republic
    Posts
    7,128
    Rep Power
    732
    6 is much easier than previous, updated in first post
    Learn 3D graphics with ThinBASIC, learn TBGL!
    Windows 10 64bit - Intel Core i5-3350P @ 3.1GHz - 16 GB RAM - NVIDIA GeForce GTX 1050 Ti 4GB

  10. #10
    Super Moderator Petr Schreiber's Avatar
    Join Date
    Aug 2005
    Location
    Brno - Czech Republic
    Posts
    7,128
    Rep Power
    732
    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
    Learn 3D graphics with ThinBASIC, learn TBGL!
    Windows 10 64bit - Intel Core i5-3350P @ 3.1GHz - 16 GB RAM - NVIDIA GeForce GTX 1050 Ti 4GB

Page 1 of 2 12 LastLast

Similar Threads

  1. AllBASIC Embedding Code Challenge
    By John Spikowski in forum Shout Box Area
    Replies: 3
    Last Post: 11-08-2009, 12:07
  2. thinBASIC QB Compatibility Code Challenge
    By John Spikowski in forum General
    Replies: 0
    Last Post: 20-06-2009, 21:22
  3. AllBasic.Info Code Challenge
    By John Spikowski in forum Events
    Replies: 0
    Last Post: 08-08-2008, 11:16
  4. tbgl coding challenge
    By kryton9 in forum TBGL General
    Replies: 4
    Last Post: 10-06-2007, 21:42
  5. thinBASIC coding challenge #1
    By Petr Schreiber in forum Challenge
    Replies: 29
    Last Post: 10-04-2007, 21:20

Members who have read this thread: 0

There are no members to list at the moment.

Posting Permissions

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