Every year, apparently, an advent calendar of coding puzzles is published at adventofcode.com. I like this kind of thing, and some of them may be non-trivial, so I figured I would give them a go like this, and if they seem interesting, pop them into my portfolio as little more than a problem solving demo - fundamentally, the problems tend to resemble interview coding problems, so might as well.
The inputs are given as plain space-separated text. I’ll use sublime to coerce these into .csv files, but make no other changes before processing in R.
The first half of day 1 involves parsing a list of calorie counts into ‘elves’ who are carrying those calories. The elves are deliniated by a blank line in the input, and the output needs to be the calorie count carried by the elf carrying the most calories. Easy enough. Parsing is an old SQL gap-detection trick, where we append an ID by running a cumulative sum over the entire input only incrimenting when it finds a blank line, as below:
calories <- fread("calories.csv")
head(calories, 10)## calories
## 1: 5474
## 2: 4920
## 3: 5381
## 4: 8650
## 5: 11617
## 6: 7193
## 7: 8161
## 8: NA
## 9: 10747
## 10: 5855As stated, I’ll use cumsum() and a simple ifelse() to append an elf identifier, then group and sum the calories
calories <- calories %>%
mutate(elf=cumsum(ifelse(is.na(calories), 1,0))) %>%
filter(!is.na(calories)) %>%
group_by(elf) %>%
summarise(tot_cals=sum(calories)) %>%
arrange(desc(tot_cals))
calories %>% head(1)## # A tibble: 1 x 2
## elf tot_cals
## <dbl> <int>
## 1 30 66306..and it is correct that elf 30 with 66306 calories carried is the most calorific elf.
Part two asks for the same, but the sum of the top three elves instead of the top elf. Using the above data, which is already ordered by descending total calories:
sum(calories[1:3,2])## [1] 195292..and right again. Easy peasy. On to day two.
The elves are having a rock-paper-scissors tournament, and we’ve been given a guide to help us cheat, but we don’t know what the notation means.
We know that the first column is the opponent’s pick (A=Rock, B=Scissors, C=Paper), and we assume that the second column is our pick (X=Rock, Y=Scissors, Z=Paper) which is calibrated so we do not win every match.
Scoring is: 6 for a win, 3 for a draw, 0 for a loss, plus 1 if we pick rock, 2 if we pick paper, 3 if we pick scissors.
This looks like:
rps <- fread("rps.csv")
head(rps)## opp you
## 1: B Z
## 2: A X
## 3: C X
## 4: C X
## 5: C Z
## 6: C XPretty much as expected.
I’m going to mutate these to the same format using utf8ToInt() - subtracting 64 from the opponent and 87 from your moves will give a 1..3 int that corresponds to the score, and allows me to make a single ‘opp=you’ check to find all draws. The rest will just be an ugly ifelse() to catch wins/losses and summing.
Apparnetly utf8ToInt() doesn’t play nice with dplyr, so I have to endure apply().
I think there is a clever thing where opp-you is either -1 or 2 in the case of wins, 0 in draws, and other results are losses, which saves some ifelse:
rps_1 <- rps
rps_1$opp <- apply(rps %>% select(opp),1,utf8ToInt)
rps_1$you <- apply(rps %>% select(you),1,utf8ToInt)
rps_1 <- rps_1 %>%
mutate(opp=opp-64, you=you-87) %>%
mutate(res_score=ifelse(opp-you==2 | opp-you==-1,6,ifelse(you==opp,3,0)))
sum(rps_1$res_score)+sum(rps_1$you)## [1] 1429714297 is correct, and I’m pretty happy to have found the little matrix ifelse() shortcut, even if I struggled making apply() do what I wanted it to.
For part two, the elf has told us that the ‘you’ column isn’t our play, but the required outcome for that round, x=loss, y=draw, z=win, so slightly different transformations.
The outcome score will have to be a simple ifelse. Plays should be doable in a clever way - draws should be equal, the winner should be one higher than the loser, looping around, and reversed for the loser. I’m just not really sure how to accomplish this logically - it should just mean looping through factor levels (R P S as levels, 4 simply loops back to 1, and 0 would loop to 3?)
Contextually I’m going to use ifelse, which feels bad. I think I should at least be using switch().
rps_2 <- rps
rps_2$opp <- apply(rps %>% select(opp),1,utf8ToInt)
rps_2 <- rps_2 %>%
mutate(opp=opp-64,res_score=ifelse(you=='Z', 6, ifelse(you=='Y',3,0))
,you=ifelse(you=='Y', opp, ifelse(you=='Z', ifelse(opp+1==4,1,opp+1), ifelse(opp-1==0,3,opp-1))))
sum(rps_2$res_score)+sum(rps_2$you)## [1] 10498..apart from needing to re-read the scoring levels to get the right answer, fine and nice.
We’re given a list of strings representing rucksack contents split between two compartments. The contents are always split evenly (first vs second half of the string) and we need to find the one item (upper or lower case letter) that exists in both compartments.
Once identified, they need to have an assigned priority score - a..z being 1..26, and A..Z being 27..52.
String manipulation always sucks a bit, but splitting known equal strings should be fine, blowing them up into lists and then comparing the lists is easy, and a little bit of math combined with utf8ToInt() from the previous should lead to the priorities without too much trouble.
split_ruck <- function(x){
item1=substr(x,1,nchar(x)/2)
item2=substr(x,nchar(x)/2+1,nchar(x))
ss1 <- strsplit(item1,"")
ss2 <- strsplit(item2,"")
return(intersect(unlist(ss1),unlist(ss2)))
}
ruck <- fread("pack.csv")
ruck$component <- apply(ruck %>% select(pack), 1, split_ruck)You know, that took me a disgusting amount of time to get right simply because I don’t use apply() or functions as often as I should. I’m sure this is a slightly clumsy example, but I will do this more often - I’m fairly certain I can get rid of a couple clumsy-ass loops in my ETL scripts with a bit of functional programming.
Anyway. Now I need to work out the priority. This should just be using utf8ToInt() and a bit of math, but a..z come after A..Z in utf8. I think I can subtract a single value and take the absolute or something similar, but it will take a bit of trial and error in console.
So, ‘A’ is 65, but needs to be 27. ‘a’ is 97 and needs to be 1.
As it turns out, this doesn’t need any dumb numeric translation stuff:
lets <- append(letters,LETTERS)
prios <- function(x){
return(which(x==lets))
}
ruck$priority <- apply(ruck %>% select(component),1,prios)
sum(ruck$priority)## [1] 7746The sum of all priorities is 7746, which gets us to part two.
Now, the elves are supposed to have grouping badges. The groups are defined by the single item common to all three elves in the group. Every three lines is one group (e.g 1:3, 4:6, etc), and I need to correctly label each group.
I think this is where a clumsly loop comes in, since I need to be
looking at a range of elves each iteration. This means iter 1 needs to
be 1..3, 2 is 4..6, etc. So, min is n-1*3+1, max is
n*3 - n=2 means 4..6, n=3 means 2*3+1 or 7 to
3*3 or 9, so this seems functional.
In each iteration, I’ll break down each pack to vectors of characters as before,
get_group <- function(x,y,z){
g1 <- unlist(strsplit(x,""))
g2 <- unlist(strsplit(y,""))
g3 <- unlist(strsplit(z,""))
return(intersect(g1,intersect(g2,g3)))
}
ruck <- ruck %>% mutate(grp="")
nr <- nrow(ruck)/3
for(i in 1:nr){
st <- (i-1)*3+1
gr <- get_group(ruck$pack[st],ruck$pack[st+1],ruck$pack[st+2])
ruck$grp[st] <- gr
ruck$grp[st+1] <- gr
ruck$grp[st+2] <- gr
}
ruck$gr_prio <- apply(ruck %>% select(grp),1,prios)
sum(ruck$gr_prio)/3## [1] 2604So: after getting the groups and getting the priorities of each group, the sum of the group priorities is 2604, and we can move on.
The elves have been assigned to clean up segments of the camp. The assignments come in pairs, expressed as ranges of camp segments. The question is: how many of the pairs have one assignment range entirely encompassed by the other range, inclusive of the start/end (e.g 1-6 encompasses 4-6.)
I think this is actually really easy? I need to split each assignemnt on the ‘-’ character, coerce everything to integers, and then just compare values - p1_min <= p2_min & p1_max >= p2_max or vice versa means a range is entirely contained.
Apparently, dplyr has a case_when() method, which is kind of nice to see.
cc <- fread("pairs.csv")
camp_clean <- function(x,y){
x <- strsplit(x,"-")
y <- strsplit(y,"-")
x_min <- as.numeric(x[[1]][1])
x_max <- as.numeric(x[[1]][2])
y_min <- as.numeric(y[[1]][1])
y_max <- as.numeric(y[[1]][2])
return(case_when(x_min <= y_min & x_max >= y_max~'1 > 2',
y_min <= x_min & y_max >= x_max~'2 > 1',
TRUE~'no'))
}
cc <- cc %>%
mutate(enc="")
cc$enc <- mapply(camp_clean,cc$p1,cc$p2)
cc %>%
filter(!enc=='no') %>%
summarise(n=n())## n
## 1 526..I could have also been a bit less clumsy in a few previous answers by using mapply() instead of forcing a single input with apply(). This is fine, though. I don’t actually know what the second part is, but just in case it involves knowing which of the pair has the wider range, I’ve included that.
My forward-looking guess was wrong: it doesn’t care which encompasses which, but we want to check if there is any intersection at all.
I don’t think this is the most efficient way to accomplish this, but I can just use the min and max values from the function above with the ‘:’ operator and intersect() to do this very easily.
camp_intersect <- function(x,y){
x <- strsplit(x,"-")
y <- strsplit(y,"-")
x_min <- as.numeric(x[[1]][1])
x_max <- as.numeric(x[[1]][2])
y_min <- as.numeric(y[[1]][1])
y_max <- as.numeric(y[[1]][2])
return(length(intersect(x_min:x_max,y_min:y_max))>0)
}
cc <- cc %>%
mutate(inter="")
cc$inter <- mapply(camp_intersect,cc$p1,cc$p2)
cc %>%
filter(inter==TRUE) %>%
summarise(n=n())## n
## 1 886Done and done. On to day 5!
The elves have crates of supplies stacked in a stockpile. Their crane operator is going to rearrange them per a supplied plan. They want to know where the crates will end up given the starting points and then plan. This is supplied in a format like:
[D] [N] [C] [Z] [M] [P] 1 2 3
move 1 from 2 to 1 move 3 from 1 to 3 move 2 from 2 to 1 move 1 from 1 to 2
When more than one crate is moved, the crates are moved sequentially - e.g moving 2 from 1 to 3 would result in N D P on 3.
I think I’m going to ‘cheat’ and split the input into two - one of the stacks and one of the instructions. I don’t know whether this is ‘spiritually’ cheating or not - there are no clear ‘rules’, and I think it makes sense that the two would be logically separated. I’m sure I could parse this properly using readlines() or similar, but if I did that I would spend more time parsing the input than doing the puzzle.
I’ve never really done something instruction based like this, but it should be fairly straightforward - a single function that accepts times, from, and to, then removes the last element from the ‘from’ stack and appends it to ‘to’ a number of times. Straightforward, I think.
It isn’t actually that straightforward, but it is similarly straightforward - changing and returning multiple objects would be quite awkward. An ugly loop that directly modifies the global variables will work fine, though.
This will still be quite questionable, though. I think I need to identify the column with the TO/FROM values as an index, extract it as a list, modify the list, and then force it back into the column. Alternately, I need to pre-process this into a list of vectors without the blank values. I think this is worthwhile.
I expected to have to parse the instruction string here, but fread() has interpreted the string as space-separated values, and given me a really easy-to-use list of ‘num - from - to’ values. I’m not going to look a gift horse in the mouth.
stacks <- fread("stacks.csv")
inst <- fread("instructions.csv")
stacklist <- list()
for(i in 1:ncol(stacks)){
stacklist <- append(stacklist,list(na_if(stacks[[i]],"") %>% na.omit()))
}
for(i in 1:nrow(inst)){
num <- inst$num[i]
from <- inst$from[i]
to <- inst$to[i]
for(x in 1:num){
swap <- stacklist[[from]][[length(stacklist[[from]])]]
stacklist[[from]][[length(stacklist[[from]])]] <- NA
stacklist[[to]] <- append(stacklist[[to]],swap)
stacklist[[from]] <- na.omit(stacklist[[from]])
}
}I mean, that feels clunky as hell, but it hasn’t broken anything. The answer requires me to concatenate the top crate of every stack:
answer <- ""
for(i in 1:length(stacklist)){
answer <- paste(answer,stacklist[[i]][[length(stacklist[[i]])]],sep="")
}
answer <- str_replace_all(answer,"\\[","")
answer <- str_replace_all(answer,"\\]","")
answer## [1] "SBPQRSCDF"I hate how R functions handle escape characters - to pass an escape character to a regex function you have to escape the escape character to escape the character you want to escape within the regex function. Amazing.
However, the answer is right, so moving on to part two: it turns out that this crane picks up multiple crates at once, retaining order when moving multiple crates. Awful. This just means uglying up the loop even more.
I don’t think it actually gets uglier - it means moving elements out of the nested loop, and ensuring swap becomes a list or vector rather than a character. Not really a big deal.
stacks <- fread("stacks.csv")
inst <- fread("instructions.csv")
stacklist <- list()
for(i in 1:ncol(stacks)){
stacklist <- append(stacklist,list(na_if(stacks[[i]],"") %>% na.omit()))
}
for(i in 1:nrow(inst)){
num <- inst$num[i]
from <- inst$from[i]
to <- inst$to[i]
swap <- list()
for(x in (length(stacklist[[from]])-(num-1)):(length(stacklist[[from]]))){
swap <- append(swap,stacklist[[from]][[x]])
stacklist[[from]][[x]] <- NA
}
stacklist[[to]] <- unlist(append(unlist(stacklist[[to]]),swap))
stacklist[[from]] <- na.omit(unlist(stacklist[[from]]))
}
answer <- ""
for(i in 1:length(stacklist)){
answer <- paste(answer,stacklist[[i]][[length(stacklist[[i]])]],sep="")
}
answer <- str_replace_all(answer,"\\[","")
answer <- str_replace_all(answer,"\\]","")
answer## [1] "RGLVRCQSB"Okay, after I wrap everything in unlist(), I get the right answer! Yippee.
For my sins, the elves have given me a malfunctioning communication device. It receives data in a constant serial stream of characters, and I need to identify the start-of-packet identifiers, and flag the count of characters before and including the start-of-packet identifier. The identifier is four sequential characters that are all different.
I think there is probably a better way to do this, but the obvious way is to step through grabbing blocks of four characters and checking to see if they’re all unique. This is quite simple, but absolutely brute force.
packet <- unlist(str_split(read_file("packet.txt"),""))
for(i in 4:length(packet)){
check <- ""
check <- check[-1]
for(x in (i-3):i){
check <- append(check,packet[x])
}
if(length(check)==length(unique(check))){
print(i)
break()}
}## [1] 1640Brute force, but easy. Part two needs a start of message marker, which is identical apart from being 14 characters rather than 4.
for(i in 14:length(packet)){
check <- ""
check <- check[-1]
for(x in (i-13):i){
check <- append(check,packet[x])
}
if(length(check)==length(unique(check))){
print(i)
break()}
}## [1] 3613I think this is karmic punishment for anyone who tried to do this with lead() or lag() wizardry rather than this brute-force nonsense. I had to change two numbers and it worked.
Onward.
Well, this one is serious now.
The communication device is out of drive space. It apparently runs some flavour of *nix, so a pile of console commands have been run to give a full breakdown of the files and directory structure on the device… one line at a time, including commands. Amazing. I’ll have to find directory sizes and things like that. Fine, fine.
This is primarily a parsing and structuring exercise, I think. I’m going to approach it by stepping through with read_lines(), keeping tabs on the current file path, and creating a table that looks like:
| file |
|---|
| test |
| bip |
This should let me get the total size of directories, construct the full file path, and so forth.
So, I need to look for:
$ at the start of line indicating a command. I think I
just strip these and look for start of line patternscd to alter the file path. If I store this as a list or
vector I can easily step back when seeing ‘..’ls which should feed in to the directory structure data
frame writing bitdir means a directory, which has 0 sizeI think this means I leverage fread()’s desire to coerce a file into
space-separated, look at the first (or first and second in the case of
$) columns to determine actions, and parse from there,
still using an ugly iterative loop.
fs <- fread("path.txt",fill=TRUE)
path <- ""[-1]
struct <- tibble(file="",
type="",
parent="",
size=0)[-1,]
for(i in 1:nrow(fs)){
if(fs$v1[i]=="$"){
#handle cd, ignore ls
if(fs$v2[i]=="cd"){
#step back if "..", reset if "/", else append v3 to path
if(fs$v3[i]==".."){
path <- path[-length(path)] #i think this one won't work as written
}else if(fs$v3[i]=="/"){
path <- "/"
}else{
path <- append(path,fs$v3[i])
}
}
}else if(fs$v1[i]=="dir"){
#append directory to struct with current max path as parent
temp <- tibble(file=fs$v2[i],
type="dir",
parent=path[length(path)],
size=0)
struct <- union(struct,temp)
}else{
#append file to struct with current max path as parent and as.numeric(v1) as size
temp <- tibble(file=fs$v2[i],
type="file",
parent=path[length(path)],
size=as.numeric(fs$v1[i]))
struct <- union(struct,temp)
}
}Right. Now I need directory sizes. I know how this should work in theory: create a recursive function that calls itself for each directory in the current directory, and when it runs out of directories, sums the file sizes in that directory. I haven’t written anything recursive outside of SQL queries in about 20 years.
fs_temp <- struct
fs_temp <- union(fs_temp,tibble(file="/",type="dir",parent=NA,size=0))
crawl_dir <- function(temp,dir){
#get list of directories
list <- temp %>%
filter(type=="dir",parent==dir) %>%
select(file) %>%
unlist()
i <- 1
#call crawl_dir for each directory
if(length(list>0)){
while(i <= length(list)){
#temp <- crawl_dir(temp,list[[i]])
print(i)
i<-i+1
}
}
#sum contents of directory
dir_index <- which(temp$type=="dir" & temp$file==dir)
size <- temp %>%
filter(parent==dir) %>%
summarise(size=sum(size)) %>%
.$size
temp[dir_index,4] <- size
return(temp)
}
fs_temp<-crawl_dir(fs_temp,"/")Right. So the above is set to not evaluate because it is somehow fucked, and I can’t quite see why.
Logically, this should take the current iteration data frame and the parent directory, make a list of directories in that parent, and call itself for those one at a time. This should make it step through to the deepest depth, sum the size of everything in that directory, append the total size to the parent, and then return the appended dataframe, which then gets passed to the next directory or returned down another level.
What happens instead is an infinite loop of recursive calls - it handles the first layer perfectly, but when it passes up to a second recursive layer, it just loops through those directories endlessly returning nothing.
I think I have worked out the issue that some directory names -
hsswswtq for instance - occur repeatedly in different
parents, meaning I really need a path variable to differentiate the
parents. This is doable.
fs <- fread("path.txt",fill=TRUE)
path <- ""[-1]
fs_parsed <- tibble(file="",
type="",
fpath="",
parent="",
depth=0,
size=0)[-1,]
for(i in 1:nrow(fs)){
if(fs$v1[i]=="$"){
#handle cd, ignore ls
if(fs$v2[i]=="cd"){
#step back if "..", reset if "/", else append v3 to path
if(fs$v3[i]==".."){
path <- path[-length(path)] #i think this one won't work as written
}else if(fs$v3[i]=="/"){
path <- "/"
}else{
path <- append(path,fs$v3[i])
}
}
}else if(fs$v1[i]=="dir"){
#append directory to struct with current max path as parent
temp <- tibble(file=fs$v2[i],
type="dir",
fpath=paste(path, collapse="/"),
parent=path[length(path)],
depth=length(path),
size=0)
fs_parsed <- union(fs_parsed,temp)
}else{
#append file to struct with current max path as parent and as.numeric(v1) as size
temp <- tibble(file=fs$v2[i],
type="file",
parent=path[length(path)],
fpath=paste(path, collapse="/"),
depth=length(path),
size=as.numeric(fs$v1[i]))
fs_parsed <- union(fs_parsed,temp)
}
}This results in an unsightly but perfectly functional //
at the start of each path, which I think I’ll just live with.
I think this means that if I pass fpath rather than a dir this might work. This might result in the ‘parent’ column being a bit prehensile.
Okay. I need to just rewrite the recursive element.
You know? I think I can do this with a comically garbage loop. I’ll get a unique list of directory paths, arrange them from longest to shortest, and then iterate through grouping them up to get the size. This will be a bit dumb because I’ll need to parse off the last directory name to put the value in the right place, but.. yeah. Instead of something janky like path length, I’ll just append depth
fs_temp <- fs_parsed
fs_temp <- union(fs_temp,tibble(file="/",type="dir",fpath="/",parent=NA,depth=1,size=0))
fp_list <- fs_temp %>%
mutate(index=row_number()) %>%
filter(type=='dir') %>%
arrange(desc(depth))
for(i in 1:nrow(fp_list)){
if (!fp_list$file[i]=="/"){
full_path <- paste(fp_list$fpath[i],fp_list$file[i],sep="/")
}else{
full_path <- fp_list$file[i]
}
size <- fs_temp %>%
filter(fpath==full_path) %>%
summarise(size=sum(size)) %>%
.$size
fs_temp$size[fp_list$index[i]] <- size
}
fs_temp %>%
filter(type=='dir',size <= 100000) %>%
summarise(tot_size=sum(size),n=n())## # A tibble: 1 x 2
## tot_size n
## <dbl> <int>
## 1 1206825 21Well, accepting that recursion isn’t required because we already had the directory structure and it was possible to just append depth during parsing and loop from deepest to shallowest made that trivially easy.Oh well.
So: The total disk space available to the filesystem is 70000000. To run the update, you need unused space of at least 30000000. You need to find a directory you can delete that will free up enough space to run the update.
This wants the size of the smallest directory that would free up enough size, which should be pretty damn easy now:
space_req <- 30000000-(70000000 - 48729145)
fs_temp %>%
filter(type=='dir', size >= space_req) %>%
arrange(size) %>%
head(1) %>%
.$size## [1] 9608311Exactly as easy as expected - subtract the size of root
/ from the total file system size to get free space,
subtract that from the update size to get the space I need to free up,
filter our data frame for directories at least that size, return the
smallest.
This will serve as a reminder to not overengineer things, and instead look at the situation in reality rather than getting weeded by a notiong of how something ‘should be’ done.
The elves have found a stand of trees which have been planted in a grid by a previous expedition, and want to decide where to build a treehouse. The only criteria they care about is visibility from an edge. This means all edge trees are valid, plus any tree that is taller than any other tree between it and one edge.
The trees are displayed as a grid of numbers, the number representing the height of the tree, as:
3 0 3 7 3 2 5 5 1 2 6 5 3 3 2 3 3 5 4 9 3 5 3 9 0
I’ll need to take a second to break these down into data frames, but after that, I’m sure there is a clever mathematic way to do this, but I’m just going to step through each row/column saving the tallest seen tree in that direction and flagging whether trees are visible or not.
How to store this is actually kind of annoying. I think just having a second ‘visible’ grid that maps identically is the way to go.
I decided to cheat slightly and use sublime’s row editing feature to add delineation rather than spending far longer doing it in R. If I’m clever, I can do the vertical and horizontal checks simultaneously, and feel a little bit better about looping.
trees <- fread("trees.txt")
vis <- data.frame(matrix(NA,nrow=nrow(trees),ncol=ncol(trees))) %>%
replace(is.na(.),FALSE)
x_height <- vector(length=99, mode="numeric")
y_height <- vector(length=99, mode="numeric")
for(x in 1:ncol(trees)){
for(y in 1:nrow(trees)){
if((trees[[y,x]] > x_height[[y]]) | x==1 | y==1 | x==99 | y==99){
x_height[[y]] <- trees[[y,x]]
vis[[y,x]] <- TRUE
}
if(trees[[y,x]] > y_height[[x]]| x==1 | y==1| x==99 | y==99){
y_height[[x]] <- trees[[y,x]]
vis[[y,x]] <- TRUE
}
}
}
# inverted pass
x_height <- vector(length=99, mode="numeric")
y_height <- vector(length=99, mode="numeric")
for(x in ncol(trees):1){
for(y in nrow(trees):1){
if((trees[[y,x]] > x_height[[y]]) | x==1 | y==1 | x==99 | y==99){
x_height[[y]] <- trees[[y,x]]
vis[[y,x]] <- TRUE
}
if(trees[[y,x]] > y_height[[x]]| x==1 | y==1| x==99 | y==99){
y_height[[x]] <- trees[[y,x]]
vis[[y,x]] <- TRUE
}
}
}
sum(vis)## [1] 1690I’m pretty happy to have got that in one with no troubleshooting or rethinking. I don’t think it is the best solution, as it is two full tablescans, but at least it isn’t four.
For part two, we calculate a ‘scenic score’ for each tree by looking in each direction from that tree, counting the number of trees that are visible, including the same or higher blocking tree it runs in to, and multiplying those counts together.
I’m just going to brute force this again. I know there must be computationally better ways to do this, but I’m a bit of an algo pleb.
scenic <- data.frame(matrix(NA,nrow=nrow(trees),ncol=ncol(trees))) %>%
replace(is.na(.),0)
x_height <- vector(length=99, mode="numeric")
y_height <- vector(length=99, mode="numeric")
for(x in ncol(trees):1){
for(y in nrow(trees):1){
x_l <- 0
x_r <- 0
y_u <- 0
y_d <- 0
x_ct <- x-1
y_ct <- y-1
while((x_ct > 0)){
x_l <- x_l+1
if(trees[[y,x_ct]] >= trees[[y,x]]){
x_ct <- 0
} else {
x_ct <- x_ct-1
}
}
while(y_ct > 0){
y_u <- y_u+1
if(trees[[y_ct,x]] >= trees[[y,x]]){
y_ct <- 0
} else {
y_ct <- y_ct-1
}
}
#reset, right and down
x_ct <- x+1
y_ct <- y+1
while((x_ct < 100)){
x_r <- x_r+1
if(trees[[y,x_ct]] >= trees[[y,x]]){
x_ct <- 100
} else {
x_ct <- x_ct+1
}
}
while(y_ct < 100){
y_d <- y_d+1
if(trees[[y_ct,x]] >= trees[[y,x]]){
y_ct <- 100
} else {
y_ct <- y_ct+1
}
}
scenic[[y,x]] <- x_l*x_r*y_u*y_d
}
}
max(scenic)## [1] 535680Very brute force, I suspect there are some fairly straightforward matrix math approaches that do this better, but I’ll take it.
I’ll continue this in part 2 just so it isn’t gargantuan.