Advent of Code, 2024 - Day 04

**Petr Schreiber** · 01-01-2025, 11:33

Happy New Year!,

I would like to share a possible solution for day 4 of Advent of Code 2024.

SPOILERS BELOW

The assignment can be found at https://adventofcode.com/2024/day/4
Please note that to reach the assignment you need to complete the assignment 3 first.

Please make sure you download your input.txt file from the page above and that you pass it as parameter to the scripts below.
In thinAir, you just enter input.txt to Script/Command line... if you stored the file side by side with the solutions.

Part 1
In the first part, your goal is to search for occurence of XMAS string in an ASCII file. The catch is in the fact the word needs to be matched not only "normally", but in all 8 possible directions.

uses "console", "file"


function tbmain()
  string inputFile = app.ArgV(2)
  
  if not file_exists(inputFile) then
    printl inputFile
    printl "Please specify valid input file as first parameter of the script"
    waitkey
    return 1
  end if
  
  string wordToFind = "XMAS"
  long errorCode
  long matchCount = GetTextOccurenceCountIn8Directions(inputFile, "XMAS", errorCode)
  
  if not errorCode then
    printl wordToFind, "found", matchCount, "times" in 14
  Else
    printl "Problem found, code:", errorCode in 12
    return errorCode
  end if
  
  waitkey
end function


function GetTextOccurenceCountIn8Directions(fileName as string, textToFind as string, byref errorCode as long) as long
  dim acode() as Byte
  long conversionResult = AsciiFile2ByteArray(fileName, acode)
  
  if conversionResult > 0 Then
    printl "Input file not in valid format, expecting ASCII file with consitent number of columns"
    errorCode = conversionResult
    exit function
  end if
  
  dim sequence(len(textToFind)) as byte at strptr(textToFind)
  long matchCount
  for x as long = 1 to ubound(acode, 1)
    for y as long = 1 to ubound(acode, 2)
      if HasByteSequence(sequence, acode, x, y, 1, 0) then incr matchCount
      if HasByteSequence(sequence, acode, x, y, 1,-1) then incr matchCount
      if HasByteSequence(sequence, acode, x, y, 0,-1) then incr matchCount
      if HasByteSequence(sequence, acode, x, y,-1,-1) then incr matchCount
      if HasByteSequence(sequence, acode, x, y,-1, 0) then incr matchCount
      if HasByteSequence(sequence, acode, x, y,-1, 1) then incr matchCount
      if HasByteSequence(sequence, acode, x, y, 0, 1) then incr matchCount
      if HasByteSequence(sequence, acode, x, y, 1, 1) then incr matchCount
    next
  next
  
  return matchCount
end function


function AsciiFile2ByteArray(fileName as string, byref targetArray() as byte)
  string lines()
  long rows = parse(file fileName, lines, $LF) - 1
  long cols = len(lines(1))
  
  #region "format validation"
  
  ' Is there anything in the file at all?
  if rows = 0 or cols = 0 then
    return 1
  end if
  
  if rows > 1 then
    ' Does the file have constant number of letters on each line?
    for i as long = 2 to rows
      if len(lines(i)) <> len(lines(1)) Then
        return 2
      end if
    next
  end if
  
  #EndRegion
  
  #region "filling the target array"
  
  redim targetArray(cols, rows)
  
  dim asciiCodes(cols) as byte at 0
  
  for y as long = 1 to rows
    setAt(asciiCodes, strptr(lines(y)))
    
    for x as long = 1 to cols
      
      targetArray(x, y) = asciiCodes(x)
      
    next
  next
  
  #EndRegion
    
end function


function HasByteSequence(byref sequence() as byte, byref scannedArray() as byte, startX as long, startY as long, dirX as long, dirY as long)
  long endX = startX + countof(sequence)*dirX - dirX
  long endY = startY + countof(sequence)*dirY - dirY
  
  if outside(endX, 1, Ubound(scannedArray, 1)) or outside(endY, 1, Ubound(scannedArray, 2)) Then
    return FALSE
  end if
  
  long stepX = iif(dirX = 0, 1, dirX)
  long stepY = iif(dirY = 0, 1, dirY)
  long itemNo
  long x, y
  
  x = startX
  y = startY
  for i as long = 1 to countof(sequence)
    if scannedArray(x, y) <> sequence(i) then
      return false
    end if
    
    x += dirX
    y += dirY
  next
  
  return true
end function

Part 2
In the second part, you actually search for a different pattern, something like:

M S
 A
M S

...and all possible variations of MAS written in cross form.

The code becomes:

uses "console", "file"


function tbmain()
  string inputFile = app.ArgV(2)
  
  if not file_exists(inputFile) then
    printl inputFile
    printl "Please specify valid input file as first parameter of the script"
    waitkey
    return 1
  end if
  
  long errorCode
  long matchCount = GetXMasOccurenceCount(inputFile, errorCode)
  
  if not errorCode then
    printl "X-MAS pattern found", matchCount, "times" in 14
  Else
    printl "Problem found, code:", errorCode in 12
    return errorCode
  end if
  
  waitkey
end function


function GetXMasOccurenceCount(fileName as string, byref errorCode as long) as long
  dim acode() as Byte
  long conversionResult = AsciiFile2ByteArray(fileName, acode)
  
  if conversionResult > 0 Then
    printl "Input file not in valid format, expecting ASCII file with consitent number of columns"
    errorCode = conversionResult
    exit function
  end if
  
  long matchCount
  for x as long = 2 to ubound(acode, 1)-1
    for y as long = 2 to ubound(acode, 2)-1
      if HasXMasAtPosition(aCode, x, y) then incr matchCount
    next
  next
  
  return matchCount
end function


function AsciiFile2ByteArray(fileName as string, byref targetArray() as byte)
  string lines()
  long rows = parse(file fileName, lines, $LF) - 1
  long cols = len(lines(1))
  
  #region "format validation"
  
  ' Is there anything in the file at all?
  if rows = 0 or cols = 0 then
    return 1
  end if
  
  if rows > 1 then
    ' Does the file have constant number of letters on each line?
    for i as long = 2 to rows
      if len(lines(i)) <> len(lines(1)) Then
        return 2
      end if
    next
  end if
  
  #EndRegion
  
  #region "filling the target array"
  
  redim targetArray(cols, rows)
  
  dim asciiCodes(cols) as byte at 0
  
  for y as long = 1 to rows
    setAt(asciiCodes, strptr(lines(y)))
    
    for x as long = 1 to cols
      
      targetArray(x, y) = asciiCodes(x)
      
    next
  next
  
  #EndRegion
    
end function


function HasXMasAtPosition(byref scannedArray() as byte, startX as long, startY as long)
  static mCode as long = asc("M")
  static aCode as long = asc("A")
  static sCode as long = asc("S")
  
  if scannedArray(startX, startY) <> aCode then
    return FALSE
  end if
  
  long firstPartOfX = (scannedArray(startX-1, startY+1) = mCode and scannedArray(startX+1, startY-1) = sCode) or _
                      (scannedArray(startX-1, startY+1) = sCode and scannedArray(startX+1, startY-1) = mCode)
  
  if not firstPartOfX Then
    return false
  end if


  long secondPartOfX = (scannedArray(startX+1, startY+1) = mCode and scannedArray(startX-1, startY-1) = sCode) or _
                       (scannedArray(startX+1, startY+1) = sCode and scannedArray(startX-1, startY-1) = mCode) 
  
  if not secondPartOfX Then
    return false
  end if
  
  return true
end function

Petr