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.