Day 11 - Very slow

Grids are back again, but quite different this time, and still no pathfinding though. Today's assignment is based on Game of Life van John Conway. A board game where cells are turned on and off based on a few rules. The rules of this grid are a little different. There are cells that do not change. And the rules on when a cell is flipped are a little different.

There are different ways to keep track of the data in a grid. Each way has its own advantages and disadvantages. Today's grid will change in rounds. In each round, a cell will get a new value based on the neighboring cells. A cell has a seat or no seat (this will not change), the cells with a seat can either be empty or occupied.

In a non-functional language, a normal solution would be to loop over the cells in the grid. In a functional language, you would map over the cells. The problem with mapping is that each cell is handled as data on its own, so had no knowledge of the location it is in the grid. My idea to counter this problem was to turn our grid into a list with elements that contain both the coordinates and the data of the cell. I saw two advantages in this approach, one I didn't have to keep track of the cells with no seats, two I didn't have to watch the boundaries of the grid, since only valid coordinates were there. One of the disadvantages that I didn't take into account was that besides mapping over all the cells I also had to lookup cells by coordinate. This is a very expansive operation because the list of cells had to be traversed to lookup a cell and this had to be done 8 times per cell, since you had to find al the neighbours. My solution worked but was really slow about 10 minutes of running time for part 1. It is quite a length solution and definitely needs cleanup

type Grid = [[Char]]
type Coord = (Int,Int)
type Seat = (Coord, Bool)
type IGrid = ((Int, Int), [Seat])

dir = [(-1,-1),(0,-1),(1,-1),(-1,0),(1,0),(-1,1),(0,1),(1,1)]
countAdjecent :: IGrid -> Coord -> Int
countAdjecent ((w,h), seats) point = count (isOccupied . findSeat . shift point) dir where
  shift (x,y) (r,d) = (x + r, y + d)
  findSeat (x,y) = lookup (x,y) seats
  isOccupied Nothing = False
  isOccupied (Just occupied) = occupied

run :: IGrid -> IGrid
run grid@(dimension,seats) = (dimension,seats') where
  rules :: Seat -> Seat
  rules seat@(point, occupied) = apply occupied (countAdjecent grid point) where
    apply False c | c == 0 = flp seat
                  | otherwise = seat
    apply True  c | c >= 4 = flp seat
                  | otherwise = seat
    flp ((x,y), occupied) = ((x,y), not occupied)
  seats' = map rules seats

index :: Grid -> IGrid
index grid = ((maxWidth, maxHeight), seats) where
  maxHeight = ((length grid) - 1)
  maxWidth = ((length $ head grid)-1)
  seats = [((x,y),c=='#') | y <- [0..maxHeight], x <- [0..maxWidth], c <- [(grid !! y) !! x], c /= '.']

solve1 :: Grid -> Int
solve1 grid = go (index grid) where
  go grid@(dim, seats) = if (grid'==grid) then count snd seats else go grid' where
    grid' = run grid

For part 2 the rules changed a bit instead of direct neighbours all seats in line of sight counted. So basically skipping all non-seats in each direction. For my implementation this made the speed even worse, it now had to check more cells, and for every non-seat cell it had to go over the complete list. Also the amount of seats that had to be filled before a seat got empty changed from 4 to 5. Changing the code from part 1 into code that could work for part 2 as well was quite easy. Creating a new countAdjecent function was a little more complex. Too my disappointment I still had to take the dimension of the grid into account now, which was one of my advantages for choosing this way.

countAdjecent2 :: IGrid -> Coord -> Int
countAdjecent2 ((w,h), seats) point = count (isOccupied . findSeat) dir where
  findSeat dir = go 1 dir where
    go m (r,d) = if inBound shifted then
                   let seat = lookup shifted seats in
                     if isJust seat then seat else go (m+1) (r,d)
                 else Nothing where
      shifted = (shift point (m * r, m * d))
      inBound (x,y) = 0<=x && x<=w && 0<=y && y<=h
      shift (x,y) (r,d) = (x + r, y + d)
  isOccupied Nothing = False
  isOccupied (Just occupied) = occupied

solve1 = solve countAdjecent 4
solve2 = solve countAdjecent2 5

Running this took about 15 minutes. I got the correct answer so good enough for the competition, but the code needs improvement, but that is for a later time. See you back in the competition tomorrow.