AoC2020 Days 17 and 18

2020-12-18

OK this time, the difficulity level went up a notch! To summarize briefly, day 17 was a 3 and 4D extension on Conway's Game of Life while day 18 consisted in performing basic arithmetic... but with different precedence order: in part 1 there was no precedence order, i. e. 1+2*3 resolves to 3*3=9; and in part 2 addition took precedence over multiplication so 3*2+1 would also resolve to 9; but in both cases parentheses still enforce precedence, meaning 2 + (3 * 4 +5) * 6 would resolve to 2 + (3 * 9) *6 = 2 + 27 * 6 = 29 * 6 = 174. The way I proceeded for day 18 was to use regex to identify sections of the input equations that needed to be solved first and then evaluate them separately and replacing the original bit by its local solution.

The workhouses of that solution are two functions, one to evaluate and the second to replace the original bits:

input <- readLines("input18.txt") #Read in the equations
input <- paste0("(",input,")") #Add parentheses around the full equations (probably not necessary but I prefer)
evaluate_unit <- function(x){ 
# x is the list of unit blocks for a given equations
# where the "precedence" is just the order of operation, 
# i. e. 3 * 5 * 2 or 4 + 3 + 6 + 7, etc. in part 2 
# or 2 + 3 * 4 etc. in part 1.
  if(length(x)){ #In some rounds of the loop there won t be any new units
    y <- strsplit(x," ") #Split by spaces
    for(i in seq_along(y)){ #For each units
      while(length(y[[i]])>1){ #while there is still elements left
        z <- eval(parse(text=paste(y[[i]][1:3],collapse=""))) #Collapse by groups of 3 (nb, op, nb) and evaluate
        y[[i]] <- c(z,y[[i]][-(1:3)]) #replace the evaluated bits by their solution
      }
    }
    return(y)
  }else{
    return(NA)
  }
}
replace_unit <- function(j, input, innermost, w){
# j is the index
# input the list of equations in their current state
# innermost is the list of solved unit blocks
# w is the result of gregexpr i. e. the position in the equation string of the blocks
    inp <- input[j]
    inn <- innermost[[j]]
    W <- w[[j]] #Positions of the first character of the blocks
    l <- attr(W,"match.length") # Length of the blocks
    L <- W+l # Positions of the last character of the blocks
    for(i in seq_along(inn)){ #For each block
      if(!is.na(inn[i])){ #If non empty
        inp <- paste0(substr(inp,1,W[i]-1),inn[i],substr(inp,L[i],nchar(inp))) #Replace
        W <- W - l[i] + nchar(inn[i]) #Change the position of next block accordingly
        L <- L - l[i] + nchar(inn[i])
      }
    }
    inp<-gsub("\\((\\d+)\\)","\\1",inp) #Rare case in which it results in things like "(549)"
    inp
}
while(!all(grepl("^\\d+$",input))){ #The actual loop (for part 2), run until all equations are replaced by a single integer
  p <- gregexpr("[0-9][0-9 +]+[0-9]",input) #Grabs addition blocks
  additions <- regmatches(input,p)
  additions <- lapply(additions,evaluate_unit) #Evaluate them
  input <- sapply(seq_along(input),function(j)replace_unit(j,input,additions,p)) #Replace them
  input <- gsub("\\(([0-9]+)\\)","\\1",input) #Make sure you dont have single integers stuck between parentheses
  w<-gregexpr("\\(([^()+]+)\\)",input) #Grab parenthese blocks
  innermost <- regmatches(input,w)
  innermost <- lapply(innermost,function(x)gsub("[()]","",x)) #Get rid of parentheses
  innermost <- lapply(innermost,evaluate_unit) #Evaluate
  input <- sapply(seq_along(input),function(j)replace_unit(j,input,innermost,w)) #Replace
}
As for day 17, i decided, instead of making a N-dimensional array actually representing the problem, to just stores the "visited" coordinates and their state. The advantage was that the code didn t need a lot of changes to go from 3d to 4d, however my code is SUPER slow (it resolved part 2 in a staggering two hours!). I'm sure there is a better solution but I couldn't figure it out. So here is my suboptimal solution (for the 4d part):
library(reshape)
input <- readLines("input17.txt")
map <- do.call(rbind,strsplit(input,""))
m <- melt(map)
m <- data.frame(x=m$X1,y=m$X2,z=0,w=0,value=m$value) #Contains coordinates of points visited and their state
neighbours <- function(m){ #Returns a list of neighbours for a given point or a full region
  mask <- expand.grid(-1:1,-1:1,-1:1,-1:1)
  M <- as.matrix(m[,1:4])
  l <- do.call(rbind,lapply(seq_len(nrow(m)),function(i)t(M[i,]+t(mask))))
  l <- l[!duplicated(l),]
  data.frame(x=l[,1],y=l[,2],z=l[,3],w=l[,4])
}
for(i in 1:6){
  p <- neighbours(m) #Grabs list of neighbours of the currently visited region
  p$value <- NA #No value at start
  coords <- apply(m[,1:4],1,paste,collapse=",") #Coordinates as string for each points that already have a value
  for(j in 1:nrow(p)){
    #For each new coordinates check content of known neighbours
    content <- table(sapply(apply(neighbours(p[j,]),1,paste,collapse=","),function(x)factor(ifelse(x%in%coords,m$value[coords==x],"."),levels=c(".","#"))))
    #Coords of point of interest
    this_cube <- paste(p[j,1:4],collapse=",")
    #Current value (if known check, if not blank)
    here <- ifelse(this_cube%in%coords,m$value[coords==this_cube],".")
    if(here=="#"&content["#"]%in%3:4){ #Apply rules, i. e. if ON and 2 or 3 neighbours are ON, keep ON
      p$value[j] <- "#"
    }else if(here=="."&content["#"]==3){ # If OFF and exactly 3 neighbours are ON, turn ON 
      p$value[j] <- "#"
    }else{ # Else turn OFF
      p$value[j] <- "."
    }
  }
  m<-p #Replace old map with new one
}

As usual you can check the full code in my repository.