Awarded with the Meta Top Contributor Award!
Advent of Code is like an advent calender for counting down the days in December till it is Christmas. But then presenting a two-part puzzle every day. You can solve the puzzle any way you like but likely you want to write some code in a programming language of choice to help you process the large puzzle input you will be presented with. And you may write some code to have the computer work out the majority if not all of the computing tasks it takes to get to the final answers.
A lot of input you will face will be in some form or the other a number of numbers, be it whole numbers of floating point numbers, separated by some marker like "x", "-", ",".
So you will need some way to get this data in appropriate variables to so the necessary computing and while there a many ways to do this, some methods are more practical than others. You also do not want to reinvent the wheel every other task, that takes up time you probably have a better use for. No talk about the leaderboard. Let's face it, the leaderboard is tiny compared to all participants and you have to be really good in your programming language and some languages can express many complex tasks in a very short compact way. (But lead also to unreadable and hence unmaintainable code).
So this is to speed up the input processing programming, not necessarily to give any chance of ever getting on the leaderboard, just forget about that.
2015 is the first year AoC was organized.
Day 1 starts off with opening and closing parenthesis. Use an editor to find "(" and ")" occurences in the inputline. Subtract the difference, that is answer part 1. Then use a simple plus 1 for "(" and minus 1 for ")" counter and count the input characters until the counter is equal to -1. Done.
Day 2 Here is our first "real" input. This consists of a large number of lines containing tuples of whole numbers like "29x13x26". Using Rebol this would have been a piece of cake, the tuple looks like this and loading as a tuple the individual tuple items could be addresses immediately. With Meta it is a little different. Meta also does not have a parse to parse the inputline into as many parts as we would like.
But we can do some clever parsing like of our own.
To process a single line of input could be done like this:
s: "29x13x26"
let [array] binary! 4 * (Size-of whole!) ; make the array one larger than we need
change/repeat array 0 4 * (Size-of whole!)
t: 1
int: 0
c: first-of s
while c [
c: first-of s
either 120 = c [
unportable change/binary at array t * size-of whole! int
increment t
int: 0
][
int: int * 10 + c - 48
]
advance s
c: first-of s
]
unportable change/binary at array t * size-of whole! int
; See if what we processed was stored correctly
for index 3 [
value: unportable as whole! at array index * size-of whole!
write "value " write index write " is " write/line value
]
write/line "Ready"
So if we need to do this a bunch of times we process our input line by line till the end of the file. I store the given input in a file with name input-<YEAR>-day-<daynumber>.txt where daynumber is always two long, day 1 gets numbered 01.
Meta [
file: "day2015-02.meta"
purpose: "Solve AoC task 2015 day 2 part 1"
]
infile: to file! "./input-2015-dag-02.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
array-size= 4 * (Size-of whole!)
let [array] binary! 4 * (Size-of whole!)
total-paper: 0
while not is-tail file-handle [
inline: take/line file-handle
write/line inline
change/repeat array 0 array-size
t: 1
int: 0
until is-tail inline [
c: first-of inline
either find/here/case inline "x" [
unportable change/binary at array t * size-of whole! int
increment t
int: 0
][
int: int * 10 + (to whole! c) - 48
]
advance inline
]
unportable change/binary at array t * size-of whole! int
l: unportable as whole! at array 1 * size-of whole!
w: unportable as whole! at array 2 * size-of whole!
h: unportable as whole! at array 3 * size-of whole!
write " l: " write l write " w: " write w write " h: " write/line h
either all [l <= w l <= h][
smallest: l
medium: either w <= h [w][h]
][
either all [w <= l w <= h][
smallest: w
medium: either l <= h [l][h]
][
smallest: h
medium: either w <= l [w][l]
]
]
this-paper: 2 * (l * w + (w * h) + (h * l)) + (smallest * medium)
total-paper: total-paper + this-paper
]
close file-handle
write/line total-paper
write/line "Ready"
As you can see, the processing is done in a very straightforward way, not the prettiest code and I have put in some write statements to illustrate and because I wanted to verify that all lines would be processed!
For what I could see, I had "WRITE l" at the end where "WRITE TOTAL-PAPER" is now and that printed "0". The extra EOL at the end caused 1 "empty" line to be read from the input. Say this is the inputfile:
27x26x11
3x2x22
14x3x5
10x9x8
So having this last empty line can have an impact. Be aware of possible side effects this has.
Thus Day 2 was solved! (Part 2 was just another calculation)
This day has an input line that is larger than 255 so we get an input line limited by this amount. But the line is more than 8000 long.
We need to concatenate the input back together! This code does just that.
inline: ""
while not is-tail file-handle [
readline: take/line file-handle
inline: join/with inline readline
unless 255 = count readline [
inline: join/with inline new-line
]
]
This day we have a helper program, part0 that finds out how far left, right, up or down the input brings us. In my case it was limited to 124 (including 0 makes 125) and we then know what limit to take into account.
In general the solutions are saving every visited point in a list of visited points and in the end count the number of list items.
I solved the problem by saving every point in its own quadrant array of 16900 (130x130) items. Then count all visited array elements.
For part 2 the solution splits into two alternating personae taking one command from the command sequence each after another. So to test if either one of them goes beyond the previous limit the helper program tests this for either of them.
Instead of splitting the array into two separate arrays of input, a counter called 'santa' is introduced. If santa is odd it is his turn else the robot takes a turn. Easy as that!
New position variables are created to keep track of the robot's position, and some code is duplicated for the robot part. This leads to the solution.
Day 4 using the md5 gave me a surprise. Luckily, friend C could come up with a suggestion.
Need to find a number such that my input combined with that number returns a md5 hash string starting with 5 zeroes. So I went on with RUN.
I do RUN command where command is calling md5sum: 'md5sum <<<"iwrupvqb9" > ./outday4.txt' Unfortunately the "<<<" does not work well.
(By the way I run this command and write to the outputfile, then I open the file and read the line with the result, given the number of times this will be performed during this task, which is just under 10.000.000 times, I question if this is not harming my SSD)
I have now found a way to make my system use the /tmp within RAM instead of on disk, so that would be less of a concern here. And this is also possible to do in Windows. Friend chatGPT knows how to do this, so go ahead and ask him/it.
So I find I should make this
echo -n iwrupvqb346386 | md5sum > ./outday4.txt
And I find different results from the terminal:
000001dbbfa3a5c83a2d506429c7b00e -
And from the program:
8005bf7006b56142732154eec088d2c7 -
As I already know the first one is correct because of an earlier solution provided in language lets call that P so needed to consult friend C again.
This time C knows that Ubuntu does not use bash shell but dash shell (what? Knew already ksh, zsh, not dash) so need to use
command: ({bash -c 'echo -n } | join/with m | join/with { | md5sum > ./outday4.txt'})
to create my command.
So finally
bash -c 'echo -n iwrupvqb346386 | md5sum > ./outday4.txt'
0000045c5e2b3911eb937d9d8c574f09 -
346386
got my result. Off course my program started just a little before the final number, just to be on the safe side for my SSD.
Second part needed an extra leading 0.
That is easy, but to stay on the safe side, I let my program start near the already found value ;-)
To be complete, Meta has been adapted for now no longer needing to use "bash -c" for this task.
Our friend let's call 'him' "C" could tell me how to check if /tmp is in RAM or on the SSD on my system. It is on SSD but "C" could also tell me how to make it so that it will be in RAM.
Is /tmp in RAM test by
mount | grep /tmp
And if you see something like
tmpfs on /tmp type tmpfs (rw,nosuid,nodev)
it is. To test if /tmp is on SSD use
df -h /tmp
And you see something like
/dev/nvme0n1p2 100G 50G 50G 50% /
it is on SSD. Use
sudo mount -o remount,size=4G,noatime /tmp
or put this line in /etc/fstab
tmpfs /tmp tmpfs defaults,size=4G 0 0
Now it will be in RAM after reboot. For Windows procedure ask your local friend "C" ;-)
This looks like the day 2 processing, so we can peek there for a quick start.
Meta [
file: "day2015-05.meta"
purpose: "Solve AoC task 2015 day 5 part 1"
]
infile: to file! "./input-2015-day-05.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
natural64! total-nice
total-nice: 0
VOWELS="aeiou"
while not is-tail file-handle [
inline: take/line file-handle
;write/line inline
if is-empty inline [
write/line "EMPTY LINE FOUND!"
continue
]
is-nice?: false
;is-decided?: false
unless any [
find inline "ab"
find inline "cd"
find inline "pq"
find inline "xy"][ ; Not even one of these
count-vowels: 0
test-vowels: inline
until is-tail test-vowels [
c: copy cut test-vowels 1
if find VOWELS c [
increment count-vowels
]
advance test-vowels
]
if count-vowels >= 3 [
; double test
test-doubles: inline
until is-tail test-doubles [
if 1 < count test-doubles [
c1: first-of test-doubles
c2: first-of next test-doubles
if c1 = c2 [
is-nice?: true
break
]
]
advance test-doubles
]
]
]
if is-nice? [
increment total-nice
]
]
close file-handle
write/line total-nice
write/line "Ready"
Who let the lights on? Turns out to be relatively simple, only real tricky part is getting the indexes right.
Hence I used another program to
find the correct value and help me debugging a little.
Meta [
file: "day2015-06.meta"
purpose: "Solve AoC task 2015 day 6 part 1"
]
write/line "Correct answer should be 569999" ; found this solution to check :-)
infile: to file! "./input-2015-day-06.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
let [lights] binary! 1000000
change/repeat lights 0 1000000
natural64! total-lights-on
total-lights-on: 0
SIZE= 1000
while not is-tail file-handle [
inline: take/line file-handle
if is-empty inline [
write/line "EMPTY LINE FOUND!"
continue
]
; write/line inline
; it is turn on/off or toggle
action: either find/here inline "turn on" [
; turn on
1
][
either find/here inline "toggle" [
;toggle
3
][
;turn off
0
]
]
; backwards is the easiest
p: find/last/tail inline ","
inline: copy cut inline (count inline) - 1 - count p
end-v: to whole! p
p: find/last/tail inline " "
inline: copy cut inline (count inline) - 9 - count p ; 9 = " through "
end-h: to whole! p
p: find/last/tail inline ","
inline: copy cut inline (count inline) - 1 - count p
start-v: to whole! p
p: find/last/tail inline " "
start-h: to whole! p
horizontal: end-h - start-h + 1
vertical: end-v - start-v + 1
;write "start-end hor: " write start-h write " " write/line end-h
;write "start-end ver: " write start-v write " " write/line end-v
;write "action: " write/line action
;write "horizontal: " write/line horizontal
;write "vertical: " write/line vertical
either action = 3 [
for index-h horizontal [
for index-v vertical [
place: (start-h + (index-h - 1)) + ((start-v + index-v - 1) * SIZE)
; write "toggle poke " write/line place
poke lights place (1 - pick lights place)
]
]
][
for index-h horizontal [
for index-v vertical [
place: (start-h + (index-h - 1)) + ((start-v + index-v - 1) * SIZE)
; write "turn poke " write place write " " write/line action
poke lights place action
]
]
]
]
close file-handle
for index 1000000 [
if 1 = pick lights index [
increment total-lights-on
]
]
write/line total-lights-on
write/line "Ready"
Awarded with the Meta Top Contributor Award!
Ay! That is one terrible formatted input and also a rather complicated construction to put together. I had to think and discuss this for some time.
It is clear that the input needs to be reformatted into something that is more straightforward to process.
Also there will be a lot of variables to keep track of.
As Meta does not have a nice dictionary or map or hashmap structure to throw our data at this will come down to doing some administration of our own. Because there are also circuits named as and at which are Meta methods it would make sense to rename those as* and at* and because there are single letter variables and now also three letter variables, I made all variables have length 3 by adding asterisks at the end. This has an additional bonus for now it will be impossible to have a collision of variable names when you put them all in one long string. Look for an "a" and you would have found the "a" from "la" if that one happened to come first.
Now I can look for the variable and find one and it is always the one and only occurrence.
Well I can explain a lot but perhaps it is best to show the 224 lines of code that makes up this circuit-cracker.
Meta [
file: "day2015-07.meta"
purpose: "Solve AoC task 2015 day 7 part 1"
]
infile: to file! "./input-2015-day-07.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
instructions: ""
named-circuits: ""
instruction-number: 0
instruction-number-of-a**: 0
let [circuits] binary! 1000 * (size-of natural16!)
let [known] binary! 1000
change/repeat known 1000 0
change/repeat circuits (1000 * (size-of natural16!)) 0
natural16! [value op1-value op2-value]
value: 0
while not is-tail file-handle [
inline: take/line file-handle
increment instruction-number
this-instruction: ""
; Split variable from end
this-instruction: join/with variable find/last/tail inline "-> "
either is-single variable [
"**"
if variable = "a" [
instruction-number-of-a**: instruction-number
write "a** found at " write/line instruction-number-of-a**
]
]["*"]
named-circuits: join/with named-circuits this-instruction
remove-end: find inline " ->"
inline: copy cut inline (count inline) - (count remove-end)
; split single numerical value ; assignment of this value
either not find inline " " [
; assignment can be of a value or another variable(!!)
either find "0123456789" copy cut inline 1 [
unportable change/binary skip circuits (instruction-number * size-of natural16!) to natural16! inline
poke known instruction-number 1
; do not write this instruction for next step
][
inline: join/with inline either is-single inline ["**"]["*"]
this-instruction: join/with join/with join/with join/with
this-instruction
"AND0" inline "0" inline
instructions: join/with join/with instructions this-instruction new-line
]
][
; split NOT instruction
either find/here/case inline "NOT" [
this-instruction: join/with this-instruction "NOT0"
variable: at inline 5
variable: join/with variable either is-single variable ["**"]["*"]
this-instruction: join/with this-instruction variable
instructions: join/with join/with instructions this-instruction new-line
][ ; split the rest of the string into 3 parts
operand-1-numeric?: operand-2-numeric?: false
operand-2: find/last/tail inline " "
either find "0123456789" copy cut operand-2 1 [
operand-2-numeric?: true
][
operand-2: join/with operand-2 either is-single operand-2 ["**"]["*"]
]
operation: copy cut find/tail inline " " 3
operand-1: copy cut inline ((count inline) - count find inline " ")
either find "0123456789" copy cut operand-1 1 [
operand-1-numeric?: true
][
operand-1: join/with operand-1 either is-single operand-1 ["**"]["*"]
]
; first numeric value
this-instruction: join/with this-instruction operation
either operand-1-numeric? [
l: count operand-1
this-instruction: join/with this-instruction form l
this-instruction: join/with this-instruction operand-1
while l < 3 [
this-instruction: join/with this-instruction " "
increment l
]
][
this-instruction: join/with join/with this-instruction "0" operand-1
]
; first numeric value
either operand-2-numeric? [
l: count operand-2
this-instruction: join/with this-instruction form l
this-instruction: join/with this-instruction operand-2
while l < 3 [
this-instruction: join/with this-instruction " "
increment l
]
][
this-instruction: join/with join/with this-instruction "0" operand-2
]
; write the formatted instruction
instructions: join/with join/with instructions this-instruction new-line
]
]
]
close file-handle
; Now process the input until the "a**" is known
instructions-resolved: 1
total-named-circuits: count named-circuits
until any [pick known instruction-number-of-a**
0 = instructions-resolved ][
instructions-resolved: 0
new-instructions: ""
while not is-tail instructions [
; per line process instructions' data
found: find/tail instructions new-line
length: (count instructions) - (count found)
my-instruction: copy cut instructions length - 1
instructions: skip instructions length
; Now see if you can solve this instruction
this-circuit: copy cut my-instruction 3
this-operation: copy cut at my-instruction 4 3
op1-num: to byte! copy cut at my-instruction 7 1
op1: copy cut at my-instruction 8 3
op2-num: to byte! copy cut at my-instruction 11 1
op2: copy cut at my-instruction 12 3
op1-value: 0
op2-value: 0
op1-known: false
op2-known: false
; solvable als beide numeriek zijn
; een van beide numeriek en de andere bekend
; beide bekend
either op1-num = 0 [
op1-instruction-number: (to whole!
divide (total-named-circuits - (count find named-circuits op1)) 3) + 1
if pick known op1-instruction-number [
op1-value: unportable as natural16! skip circuits op1-instruction-number * size-of natural16!
op1-known: true
]
][
op1-known: true
op1-value: to natural16! copy cut op1 op1-num
]
either all [this-operation != "NOT" op2-num = 0] [
op2-instruction-number: (to whole!
divide (total-named-circuits - (count find named-circuits op2)) 3) + 1
if pick known op2-instruction-number [
op2-value: unportable as natural16! skip circuits op2-instruction-number * size-of natural16!
op2-known: true
]
][
op2-known: true
if this-operation != "NOT" [
op2-value: to natural16! copy cut op2 op2-num
]
]
either all [op1-known op2-known][
; resolve the instruction!!
increment instructions-resolved
write "instruction resolved: " write my-instruction
if this-operation = "AND" [
value: op1-value AND op2-value
]
if this-operation = "OR " [
write/line circ-string
value: op1-value OR op2-value
]
if this-operation = "NOT" [
value: NOT op1-value
]
if this-operation = "RSH" [
value: SHIFT/RIGHT op1-value op2-value
]
if this-operation = "LSH" [
value: SHIFT/LEFT op1-value op2-value
]
op-instruction-number: (to whole!
divide (total-named-circuits - (count find named-circuits this-circuit)) 3) + 1
poke known op-instruction-number 1
unportable change/binary skip circuits (op-instruction-number * size-of natural16!) value
][
new-instructions: join/with join/with new-instructions
my-instruction new-line
]
]
instructions: new-instructions
]
if pick known instruction-number-of-a** [
write "Now a is known! Its value is "
value: unportable as natural16! skip circuits instruction-number-of-a** * size-of natural16!
write/line value
]
write/line "Ready"
And it must be said, one improvement that can go to the list is
either 1 = count inline [
inline: join/with inline "**"
][
inline: join/with inline "*"
]
to become
inline: join/with inline either is-single inline ["**"]["*"]
I'll just show part 1 here, the other way around is sooo much simpler.
Meta [
file: "day2015-08.meta"
purpose: "Solve AoC task 2015 day 8 part 1"
]
infile: to file! "./input-2015-dag-08.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
total-char: 0
pure-length: 0
while not is-tail file-handle [
inline: take/line file-handle
length: count inline
info: join/with join/with join/with join/with "" inline " l=" form length " chars="
line-total: 0
inline: copy cut at inline 2 line-pure-length: length - 2
until is-tail inline [
if find/here inline "\" [
skip-length: 1
if find/here inline "\x" [
skip-length: 3
]
if any [find/here inline "\\"
find/here inline {\"} ][
skip-length: 1
]
inline: skip inline skip-length
][
advance inline
]
]
pure-length: pure-length + line-pure-length
total-char: total-char + length
info: join/with info form line-pure-length
;write/line info
]
close file-handle
write/line pure-length
write/line total-char
write/line total-char - pure-length
write/line "Ready"
The only thing to take into account is you will have to add 2 to the result of every line because it must become a string again.
This day it was not much about the input. You could use the split by spaces from the examples page to process the lines.
Tristram to AlphaCentauri = 34
Throw away the 'to' and '=' parts. Then save all names in a string when the name of the place is not already in there. Count the "indexes" of the city names and put the distance given into an array.
The really tricky part is the generating of lexicographic ordered permutations, which for the 8 cities is a number of 201600 and that is a bit much to make into a string of that many lines and 8 chars per line. Could be done maybe but my naive program got killed by the system.
So I found out that Python used a thing called itertools to generate each permutation from the previous. And though the source is open, I did not want to put much effort in understanding that kind of code it is made with. Even the AI bots chatGPT and Deepseek failed inexplaining the working to me, as there was always some detail wrong or unclear. Eventually I kind of grasped how it worked in detail.
But something was not feeling right. It just seemed that the method itself was bloated.
So I went for a search. And within minutes I found what I was looking for. Some dude Dijkstra had already written the algorithm before even I was born!
A complete article with even some other algorithms to compare.
It was written in Pascal and it was a relief to read that and it was pretty straightforward to translate to Meta.
This was indeed the fast algorithm I had need for and the program I made to solve Day 9 is here.
Meta [
file: "day2015-09.meta"
purpose: "Solve AoC task 2015 day 9 part 1 and 2"
]
let distances binary! 90
change/repeat distances 0 90
poke distances 12 34
poke distances 21 34
poke distances 13 100
poke distances 31 100
poke distances 14 63
poke distances 41 63
poke distances 15 108
poke distances 51 108
poke distances 16 111
poke distances 61 111
poke distances 17 89
poke distances 71 89
poke distances 18 132
poke distances 81 132
poke distances 23 4
poke distances 32 4
poke distances 24 79
poke distances 42 79
poke distances 25 44
poke distances 52 44
poke distances 26 147
poke distances 62 147
poke distances 27 133
poke distances 72 133
poke distances 28 74
poke distances 82 74
poke distances 34 105
poke distances 43 105
poke distances 35 95
poke distances 53 95
poke distances 36 48
poke distances 63 48
poke distances 37 88
poke distances 73 88
poke distances 38 7
poke distances 83 7
poke distances 45 68
poke distances 54 68
poke distances 46 134
poke distances 64 134
poke distances 47 107
poke distances 74 107
poke distances 48 40
poke distances 84 40
poke distances 56 11
poke distances 65 11
poke distances 57 66
poke distances 75 66
poke distances 58 144
poke distances 85 144
poke distances 67 115
poke distances 76 115
poke distances 68 135
poke distances 86 135
poke distances 78 127
poke distances 87 127
let order binary! MAX= 8
for index MAX [
poke order index index
]
route: ""
whole! last-permutation
last-permutation: 1
for index MAX [
route: (route | join/with form pick order index)
last-permutation: last-permutation * index
]
;write/line last-permutation
;write/line route ; eerste permutatie
shortest-distance: 10000 ; found 279 by manual trial and error
longest-distance: 0
shortest-route: ""
longest-route: ""
distance: 0
; Run through generated permutations
repeat last-permutation - 1 [
i: MAX - 1
while (pick order i) >= (pick order (i + 1)) [ decrement i ]
j: MAX
while (pick order j) <= (pick order (i)) [ decrement j ]
; swap order i en order j
swap: pick order i
poke order i pick order j
poke order j swap
increment i
j: MAX
while i < j [
; swap order i en order j
swap: pick order i
poke order i pick order j
poke order j swap
increment i
decrement j
]
route: ""
for index MAX [
route: (route | join/with form pick order index)
]
; The new permutation is ready here in route
distance: (to whole! pick distances to whole! copy cut route 2)
+ (pick distances to whole! copy cut at route 2 2)
+ (pick distances to whole! copy cut at route 3 2)
+ (pick distances to whole! copy cut at route 4 2)
+ (pick distances to whole! copy cut at route 5 2)
+ (pick distances to whole! copy cut at route 6 2)
+ (pick distances to whole! copy cut at route 7 2)
;write "total dist here: " write/line distance
if distance < shortest-distance [
shortest-distance: distance
shortest-route: route
]
if distance > longest-distance [
longest-distance: distance
longest-route: route
]
]
write "Shortest route was " write shortest-route write " with distance " write/line shortest-distance
write "Longest route was " write longest-route write " with distance " write/line longest-distance
No special inputfile here. Just a string with characters 1, 2, 3.
The problem here is that the output is growing out of bounds.
So a naive approach is not working.
By searching other solutions, I found out that the answers for part 1 and 2 (40 vs 50 iterations) result in 329356 and 4666278.
That is just under 5000000, 5 million. It appears that, while there is enough memory in your computer, it may not like strings that are big very much over 51438 in length, maybe double that, anyway not nearly enough, but making arrays that are much larger is OK.
Meta [
file: "2015-day-10.meta"
purpose: "Solve AoC task 2015 day 10 part 1 and 2"
]
; Conway's look and say.
input: "3113322113"
write/line input
let [stepa stepb] binary! 5000000
change/repeat stepa 0 5000000
change/repeat stepb 0 5000000
whole! index
index: 1
until is-tail input [
c: to byte! copy cut input 1
poke stepa index c
advance input
increment index
]
previous: 0
c: 0
n: 1
a-index: 1
b-index: 1
for repetitions 50 [
previous: c
c: pick stepa a-index
while 0 < c [
either c = previous [
increment n
][
if 0 < previous [
poke stepb b-index n
increment b-index
poke stepb b-index previous
increment b-index
n: 1
]
]
increment a-index
previous: c
c: pick stepa a-index
]
poke stepb b-index n
increment b-index
poke stepb b-index previous
increment b-index
index: 1
b-val: pick stepb index
while 0 < b-val [
poke stepa index b-val
increment index
b-val: pick stepb index
;write b-val write " "
]
previous: 0
c: 0
n: 1
a-index: 1
b-index: 1
testindex: 1
t: pick stepa testindex
while 0 < t [
increment testindex
t: pick stepa testindex
]
write "After " write repetitions write " " write/line (testindex - 1)
]
write/line "Ready"
"This seems like a problem that's easier to solve by hand than to try to solve with programming."
"Dumb puzzle" maybe if you were expecting a coding challenge but saw a way to just figure it out without any programming.
As someone explained how to find the answer: "Solved by reasoning:"
The difficult requirements are
* must have two sets of double letters (aa, bb, etc)
* must have three consecutive ascending letters (abc, bcd, etc)
The shortest way to meet these requirements is with a string of the form "aabcc"
As we are looking for the *next* password, we will only change characters at the end of the string, and we will
change as few as possible.
So, assuming that our last password does not have any double letters, ascending characters or forbidden
characters early in the string, we're looking for the next string of the form "xxx11233" - i.e. the starting letters
remain the same and we end up with an "aabcc" pattern at the end.
To find the next possible password, we avoid changing the fifth from last letter if at all possible.
My input is vzbxkghb - x is the fifth from last letter
Therefore, the first four characters can stay the same and the next password is vzbxxyzz
For the password after this, I must increment the fifth from last character. Neither y or z can start an aabcc string
so we wrap around to a. The next password is vzcaabcc.
So do we need a program? Maybe. It would be interesting to see how to do what we did for the permutations earlier now that it is not a decimal system but one a little larger.
"abcdefghijklmnopqrstuvwxyz" without i, o and l
"abcdefghjkmnpqrstuvwxyz"
23-cimal, base 23.
We could iterate through these letters. Finding the next is simple enough
; current-letter holds the current letter
letters: "abcdefghjkmnpqrstuvwxyza"
next-letter: copy cut next find letter current-letter
if next-letter = "a" [
; also give one or more letters to the left a spin
]
Then test the conditions. "I'll leave that as an exercise for the reader." - don't you hate that? Sure!
This input looks like a multiline input in the browser but in fact it is just a single line. This looks familiar, done something like this on the Day 3 task.
Meta [
file: "2015-day-12.meta"
purpose: "Solve AoC task 2015 day 12 part 1"
]
infile: to file! "./input-2015-day-12.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
total-value: 0
inline: ""
while not is-tail file-handle [
readline: take/line file-handle
inline: join/with inline readline
unless 255 = count readline [
inline: join/with inline new-line
]
]
close file-handle
collect-number: ""
collect-number?: off
while not is-tail inline [
c: copy cut inline 1
either find "-0123456789" c [
collect-number?: on
collect-number: (collect-number | join/with c)
][
if collect-number? [
collect-number?: off
this-number: to whole! collect-number
total-value: total-value + this-number
collect-number: ""
]
]
advance inline
]
write/line total-value
write/line "Ready"
Part 2 every object containing "red" must be ignored. I like the idea to ignore #F00 ;-)
My first take was to just collect all object info and discard it whenever there was any of that colour in there. But that took out too much.
Then I found that there were obects nested as deep as 5 levels. Thus I tried to collect all per nesting level, using 5 different object collectors. But alas. Where did that go wrong? Ah the nesting is not properly 1 on 1. That means the end solution should first check on all fifth level depth objects, then on 4 ( and 5 together) then 3 (and 4 and 5) etcetera.
Well then easy peasy.
Meta [
file: "2015-day-12.part2.meta"
purpose: "Solve AoC task 2015 day 12 part 2"
]
; 87842 is the correct answer for the input
file: ./input-2015-day-12.txt
Either file-handle= try OPEN file [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
total-value: 0
inline: ""
while not is-tail file-handle [
readline: take/line file-handle
inline: join/with inline readline
unless 255 = count readline [
inline: join/with inline new-line
]
]
close file-handle
collect-object: ""
collect-object?: off
; found a maximum depth of 5
collect-depth: 0
;max-depth: 0
for depth-limit [5 1][
new-inline: ""
while not is-tail inline [
c: copy cut inline 1
if "{" = c [
increment collect-depth
;if collect-depth > max-depth [max-depth: collect-depth]
either collect-depth >= depth-limit [
collect-object?: on
collect-object: (collect-object | join/with c)
][
new-inline: (new-inline | join/with c)
]
;continue
]
if "}" = c [
either collect-depth >= depth-limit [
collect-object: (collect-object | join/with c)
][
new-inline: (new-inline | join/with c)
]
decrement collect-depth
if collect-depth < depth-limit [
collect-object?: off
if find collect-object {:"red"} [
write "Dropped: " write/line collect-object
collect-object: ""
]
new-inline: (new-inline | join/with collect-object)
collect-object: ""
]
;continue
]
if not any ["{" = c "}" = c ][
either collect-object? [
if collect-depth >= depth-limit [
collect-object: (collect-object | join/with c)
]
][
new-inline: (new-inline | join/with c)
]
]
advance inline
]
;write/line max-depth
inline: new-inline
write/line inline
]
total-value: 0
collect-number: ""
collect-number?: off
while not is-tail inline [
c: copy cut inline 1
either find "-0123456789" c [
collect-number?: on
collect-number: (collect-number | join/with c)
][
if collect-number? [
collect-number?: off
this-number: to whole! collect-number
total-value: total-value + this-number
collect-number: ""
]
]
advance inline
]
write/line total-value
write/line "Ready"
It still was a bit harder than expected especially because I did not collect the "{" and "}" to the new-inline at first.
Another permutations thing!
Alice would gain 71 happiness units by sitting next to Eric.
Alice would lose 22 happiness units by sitting next to Frank.
Processing the input here we could find/here for the first letter, then find/tail " " and again then "gain" or "lose" and finally find/tail for "happiness units by sitting next to " and find the other person info of first letter.
There are entries for candidates in both directions.
There was 1 integer input with length 3. Tricky!!
For part 1, I just used a spreadsheet to calculate each travelled distance. I calculated the duration of each reindeers cycle of running and resting, then calculated how many whole cycli would be completed in 2503 seconds. Of course you should not use any different number of seconds like 2053. I now had the base distance and only needed to add the minimum of the remaining seconds and the number of seconds the reindeer can run in their cyclus of running and resting multiplied by their speed.
For part 2, well it looks like I do need to import some data anyhow. Then run the race second after second checking who is in the lead and scores a point.
It appears there are more reindeer than the one I called Tedje, tete-de-la-course, in the lead at any time. I left Tedje in the source allthough he doesn't do much.
Meta [
file: "2015-day-14.meta"
purpose: "Solve AoC task 2015 day 14 part 2"
]
infile: to file! "./input-2015-day-14.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
most-reindeer= 9
inline: ""
names: " " ; ten spaces to skip first entry
reindeer: 0
let [speed runtime resting cycle] binary! most-reindeer
change/repeat speed 0 most-reindeer
change/repeat runtime 0 most-reindeer
change/repeat resting 0 most-reindeer
change/repeat cycle 0 most-reindeer
let [distance score] binary! (most-reindeer + 1) * size-of natural16!
change/repeat distance 0 (most-reindeer + 1) * size-of natural16!
change/repeat score 0 (most-reindeer + 1) * size-of natural16!
inline: take/line file-handle
while not is-tail file-handle [
increment reindeer
tel: 0
naam-regel: inline
until is-tail naam-regel [
if find/here naam-regel " " [break]
advance naam-regel
increment tel
]
names: join/with names copy cut inline tel
add-spaces: 10 - tel
while add-spaces [
names: join/with names " "
decrement add-spaces
]
inline: find/tail inline "fly "
poke speed reindeer to byte! copy cut inline 2
inline: find/tail inline "for "
t: to byte! copy cut inline 2
poke runtime reindeer t
inline: find/tail inline "for "
r: to byte! copy cut inline 3
poke resting reindeer r
poke cycle reindeer (t + r)
inline: take/line file-handle
]
close file-handle
write/line names
for index reindeer [
write "index: " write index
write " name: " write copy cut skip names 10 * index 10
write " speed: " write pick speed index
write " runtime: " write pick runtime index
write " resting: " write pick resting index
write " cycle: " write/line pick cycle index
]
let distance-deer natural16! 0
let speed-deer byte! 0
max-distance: 0
for seconds 2503 [
for deer reindeer [
cycle-length: pick cycle deer
m: 1 + modulo (seconds - 1) cycle-length
deerrun: pick runtime deer
if m <= deerrun [
; increase distance
distance-deer: unportable as natural16! skip distance deer * size-of natural16!
speed-deer: pick speed deer
distance-deer: distance-deer + speed-deer
unportable change/binary skip distance deer * size-of natural16! distance-deer
]
; check distance to max-distance
distance-deer: unportable as natural16! skip distance deer * size-of natural16!
if distance-deer >= max-distance [
max-distance: distance-deer
]
]
; increase score for leading deer
for leader-index most-reindeer [
distance-deer: as natural16! skip distance leader-index * size-of natural16!
if distance-deer = max-distance [
score-deer: as natural16! skip score leader-index * size-of natural16!
increment score-deer
change/binary skip score leader-index * size-of natural16! score-deer
]
]
]
write/line "Conclusion"
for final-index reindeer [
write "index: " write final-index
write " name: " write copy cut skip names 10 * final-index 10
write " distance: " write unportable as natural16! skip distance final-index * size-of natural16!
write " score: " write/line unportable as natural16! skip score final-index * size-of natural16!
]
Bake some cookies here. The recipe needs to be exact. Part 2: Mind the calories!
Meta [
file: "2015-day-15.meta"
purpose: "Solve AoC task 2015 day 15 part 1"
]
; 21367368
; 1766400
infile: to file! "./input-2015-day-15.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
;Sprinkles: capacity 2, durability 0, flavor -2, texture 0, calories 3
;Butterscotch: capacity 0, durability 5, flavor -3, texture 0, calories 3
;Chocolate: capacity 0, durability 0, flavor 5, texture -1, calories 8
;Candy: capacity 0, durability -1, flavor 0, texture 5, calories 8
inline: ""
let [cap dur fla tex cal] binary! 4
change/repeat cap 0 4
change/repeat dur 0 4
change/repeat fla 0 4
change/repeat tex 0 4
change/repeat cal 0 4
inline: take/line file-handle
place: 1
while not is-tail file-handle [
inline: find/tail inline "capacity "
capacity: either find/here inline "-" [
to whole8! copy cut inline 2
][
to whole8! copy cut inline 1
]
unportable change/binary at cap place to whole8! capacity
inline: find/tail inline "durability "
durability: either find/here inline "-" [
to whole8! copy cut inline 2
][
to whole8! copy cut inline 1
]
unportable change/binary at dur place to whole8! durability
inline: find/tail inline "flavor "
flavor: either find/here inline "-" [
to whole8! copy cut inline 2
][
to whole8! copy cut inline 1
]
unportable change/binary at fla place to whole8! flavor
inline: find/tail inline "texture "
texture: either find/here inline "-" [
to whole8! copy cut inline 2
][
to whole8! copy cut inline 1
]
unportable change/binary at tex place to whole8! texture
inline: find/tail inline "calories "
calories: either find/here inline "-" [
to whole8! copy cut inline 2
][
to whole8! copy cut inline 1
]
unportable change/binary at cal place to whole8! calories
increment place
inline: take/line file-handle
]
close file-handle
for index 4 [
write index write " cap " write unportable as whole8! at cap index
write " dur " write unportable as whole8! at dur index
write " fla " write unportable as whole8! at fla index
write " tex " write unportable as whole8! at tex index
write " cal " write/line unportable as whole8! at cal index
]
score: 0
MAX-SCORE: 0
;size! i
for i [0 100] [
for j [0 (100 - i)][
for k [0 (100 - i - j)] [
h: 100 - i - j - k
capacity: (to whole! unportable as whole8! at cap 1) * i
+ (j * to whole! unportable as whole8! at cap 2)
+ (k * to whole! unportable as whole8! at cap 3)
+ (h * to whole! unportable as whole8! at cap 4)
durability: (to whole! unportable as whole8! at dur 1) * i
+ (j * to whole! unportable as whole8! at dur 2)
+ (k * to whole! unportable as whole8! at dur 3)
+ (h * to whole! unportable as whole8! at dur 4)
flavor: (to whole! as whole8! at fla 1) * i
+ (j * to whole! unportable as whole8! at fla 2)
+ (k * to whole! unportable as whole8! at fla 3)
+ (h * to whole! unportable as whole8! at fla 4)
texture: (to whole! as whole8! at tex 1) * i
+ (j * to whole! unportable as whole8! at tex 2)
+ (k * to whole! unportable as whole8! at tex 3)
+ (h * to whole! unportable as whole8! at tex 4)
calories: (to whole! as whole8! at cal 1) * i
+ (j * to whole! unportable as whole8! at cal 2)
+ (k * to whole! unportable as whole8! at cal 3)
+ (h * to whole! unportable as whole8! at cal 4)
;extra condition for part 2
if not calories = 500 [
continue
]
if any [ capacity <= 0
durability <= 0
flavor <= 0
texture <= 0
][
score: 0
continue
]
score: capacity * durability * flavor * texture
if score > MAX-SCORE [
save-cap: i
save-dur: j
save-fla: k
save-tex: h
MAX-SCORE: score
]
]
]
]
WRITE/LINE MAX-SCORE
write "max cap: " write/line save-cap
write "max dur: " write/line save-dur
write "max fla: " write/line save-fla
write "max tex: " write/line save-tex
Remembering which Aunt Sue did what.
Meta [
file: "2015-day-16.meta"
purpose: "Solve AoC task 2015 day 16 part 1"
]
infile: to file! "./input-2015-day-16.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
;
auntsue: {children: 3
cats: 7
samoyeds: 2
pomeranians: 3
akitas: 0
vizslas: 0
goldfish: 5
trees: 3
cars: 2
perfumes: 1
}
inline: ""
auntnumber: 0
inline: take/line file-handle
while not is-tail file-handle [
increment auntnumber
inline: find/tail inline ": "
length: count inline
nextitems: find inline ","
skipitem: length - count nextitems
firstitem: copy cut inline skipitem
if find auntsue firstitem [
inline: skip inline skipitem + 2
length: count inline
nextitems: find inline ","
skipitem: length - count nextitems
seconditem: copy cut inline skipitem
if find auntsue seconditem [
inline: skip inline skipitem + 2
if find auntsue inline [
break
]
]
]
inline: take/line file-handle
]
close file-handle
WRITE/LINE auntnumber
Part 2. I reduced the possibilities and then checked the last ones.
A nice puzzle testing all combinations of 20 elements.
Meta [
file: "2015-day-17.meta"
purpose: "Solve AoC task 2015 day 17 part 1"
]
; answer 4372
let container binary! 20
poke container 1 11
poke container 2 30
poke container 3 47
poke container 4 31
poke container 5 32
poke container 6 36
poke container 7 3
poke container 8 1
poke container 9 5
poke container 10 3
poke container 11 32
poke container 12 36
poke container 13 15
poke container 14 11
poke container 15 46
poke container 16 26
poke container 17 28
poke container 18 1
poke container 19 19
poke container 20 3
number-of-combinations: 0
base: 2
highest: (base ^ 20) - 1
;write/line highest
testnumber: 1
while testnumber <= highest [
sum-containers: 0
if testnumber and 524288 [sum-containers: sum-containers + unportable as byte! at container 20]
if testnumber and 262144 [sum-containers: sum-containers + unportable as byte! at container 19]
if testnumber and 131072 [sum-containers: sum-containers + unportable as byte! at container 18]
if testnumber and 65536 [sum-containers: sum-containers + unportable as byte! at container 17]
if testnumber and 32768 [sum-containers: sum-containers + unportable as byte! at container 16
if sum-containers > 150 [
testnumber: testnumber + 32768
continue
]
]
if testnumber and 16384 [sum-containers: sum-containers + unportable as byte! at container 15
if sum-containers > 150 [
testnumber: testnumber + 16384
continue
]
]
if testnumber and 8192 [sum-containers: sum-containers + unportable as byte! at container 14
if sum-containers > 150 [
testnumber: testnumber + 8192
continue
]
]
if testnumber and 4096 [sum-containers: sum-containers + unportable as byte! at container 13
if sum-containers > 150 [
testnumber: testnumber + 4096
continue
]
]
if testnumber and 2048 [sum-containers: sum-containers + unportable as byte! at container 12
if sum-containers > 150 [
testnumber: testnumber + 2048
continue
]
]
if testnumber and 1024 [sum-containers: sum-containers + unportable as byte! at container 11
if sum-containers > 150 [
testnumber: testnumber + 1024
continue
]
]
if testnumber and 512 [sum-containers: sum-containers + unportable as byte! at container 10
if sum-containers > 150 [
testnumber: testnumber + 512
continue
]
]
if testnumber and 256 [sum-containers: sum-containers + unportable as byte! at container 9
if sum-containers > 150 [
testnumber: testnumber + 256
continue
]
]
if testnumber and 128 [sum-containers: sum-containers + unportable as byte! at container 8
if sum-containers > 150 [
testnumber: testnumber + 128
continue
]
]
if testnumber and 64 [sum-containers: sum-containers + unportable as byte! at container 7
if sum-containers > 150 [
testnumber: testnumber + 64
continue
]
]
if testnumber and 32 [sum-containers: sum-containers + unportable as byte! at container 6
if sum-containers > 150 [
testnumber: testnumber + 32
continue
]
]
if testnumber and 16 [sum-containers: sum-containers + unportable as byte! at container 5
if sum-containers > 150 [
testnumber: testnumber + 16
continue
]
]
if testnumber and 8 [sum-containers: sum-containers + unportable as byte! at container 4
if sum-containers > 150 [
testnumber: testnumber + 8
continue
]
]
if testnumber and 4 [sum-containers: sum-containers + unportable as byte! at container 3
if sum-containers > 150 [
testnumber: testnumber + 4
continue
]
]
if testnumber and 2 [sum-containers: sum-containers + unportable as byte! at container 2
if sum-containers > 150 [
testnumber: testnumber + 2
continue
]
]
if testnumber and 1 [sum-containers: sum-containers + unportable as byte! at container 1
if sum-containers > 150 [
testnumber: testnumber + 1
continue
]
]
; if testnumber < 100 [write testnumber write " " write/line sum-containers]
if sum-containers = 150 [
increment number-of-combinations
]
increment testnumber
]
WRITE/LINE number-of-combinations
Don't forget to put out the lights if you leave.
Meta [
file: "day2015-18.meta"
purpose: "Solve AoC task 2015 day 18 part 1"
]
infile: to file! "./input-2015-day-18.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
LIGHTS-SIZE= 10404
let [lights new-lights] binary! LIGHTS-SIZE
change/repeat lights 0 LIGHTS-SIZE
change/repeat new-lights 0 LIGHTS-SIZE
total-lights-on: 0
SIZE= 102
add-index: 0
row: 1
add-index: row * size + 1
while not is-tail file-handle [
inline: take/line file-handle
if is-empty inline [
write/line "EMPTY LINE FOUND!"
continue
]
column: 1
until is-empty inline [
if find/here inline "#" [
poke lights (add-index + column) 1
]
increment column
inline: next inline
]
increment row
add-index: row * size + 1
]
; Just for checking if the input has been taken in OK.
;checkstring: ""
;for x [1 100][
; for y [1 100][
; checkstring: join/with checkstring either 1 = pick lights ((to whole! x) * size + 1 + y)["#"]["."]
; ]
; checkstring: join/with checkstring new-line
;]
; All these join/with statements are very ineffective and preferrable better to just write each one individually
; join/with is memory intensive , trashing and possibly leaking memory, so use only temporarily with debugging and while developing.
;write/line checkstring
close file-handle
; do 100 steps
repeat 100 [
; set new-lights from lights
for r [1 100] [
for c [1 100] [
field: (to whole! r) * 102 + 1 + c
around-field: (to whole! pick lights (field - 103))
+ (pick lights (field - 102))
+ (pick lights (field - 101))
+ (pick lights (field - 1))
+ (pick lights (field + 1))
+ (pick lights (field + 101))
+ (pick lights (field + 102))
+ (pick lights (field + 103))
;
; if all [r = 1 c = 1][write "field " write field write " checking "
; write field - 103 write " value " write/line pick lights (field - 103)
; write field - 102 write " value " write/line pick lights (field - 102)
; write field - 101 write " value " write/line pick lights (field - 101)
; write field - 1 write " value " write/line pick lights (field - 1)
; write field + 1 write " value " write/line pick lights (field + 1)
; write field + 101 write " value " write/line pick lights (field + 101)
; write field + 102 write " value " write/line pick lights (field + 102)
; write field + 103 write " value " write/line pick lights (field + 103)
; ]
either 1 = (pick lights field) [
if any [around-field = 2
around-field = 3][
poke new-lights field 1
]
][
if around-field = 3 [
poke new-lights field 1
]
]
]
]
; update lights on the new values
for index 10404 [
poke lights index pick new-lights index
]
change/repeat new-lights 0 LIGHTS-SIZE
]
for index LIGHTS-SIZE [
if 1 = pick lights index [
increment total-lights-on
]
]
write/line total-lights-on
checkstring: ""
for x [1 100][
for y [1 100][
checkstring: join/with checkstring either 1 = pick lights ((to whole! x) * size + 1 + y)["#"]["."]
]
checkstring: join/with checkstring new-line
]
WRITE/LINE checkstring
write/line "Ready"
Sneaky puzzle. The input can be stopped after the empty line is found. The last line was copy and paste into the sourcecode.
Meta [
file: "2015-day-19.meta"
purpose: "Solve AoC task 2015 day 19 part 1"
]
; ANSWER 535
molecule: "CRnCaCaCaSiRnBPTiMgArSiRnSiRnMgArSiRnCaFArTiTiBSiThFYCaFArCaCaSiThCaPBSiThSiThCaCaPTiRnPBSiThRnFArArCaCaSiThCaSiThSiRnMgArCaPTiBPRnFArSiThCaSiRnFArBCaSiRnCaPRnFArPMgYCaFArCaPTiTiTiBPBSiThCaPTiBPBSiRnFArBPBSiRnCaFArBPRnSiRnFArRnSiRnBFArCaFArCaCa
CaSiThSiThCaCaPBPTiTiRnFArCaPTiBSiAlArPBCaCaCaCaCaSiRnMgArCaSiThFArThCaSiThCaSiRnCaFYCaSiRnFYFArFArCaSiRnFYFArCaSiRnBPMgArSiThPRnFArCaSiRnFArTiRnSiRnFYFArCaSiRnBFArCaSiRnTiMgArSiThCaSiThCaFArPRnFArSiRnFArTiTiTiTiBCaCaSiRnCaCaFYFArSiThCaPTiBPTiBCaSiThSiRnM
gArCaF"
molecule-length: count molecule
number-of-molecules: 0
new-molecules: ""
molecule-marker: "*"
all-options: 0
infile: to file! "./input-2015-day-19.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
inline: take/line file-handle
while not is-tail file-handle [
if is-empty inline [
write/line "All replacements read"
break
]
;write "inline: " write/line inline
atom-length: either find/here at inline 2 " " [1][2]
;write "atom-length: " write/line atom-length
to-replace: copy cut inline atom-length
;write "to-replace: " write/line to-replace
replace-with: find/tail inline "=> "
;write/line molecule-length
size! k
for k [1 molecule-length] [
;write "k: " write/line k
;write "check for : " write/line to-replace
if find/here/case at molecule k to-replace [
write "replacing " write to-replace write " by " write/line replace-with
test-molecule: join/with join/with join/with join/with molecule-marker copy cut molecule k - 1
replace-with
copy cut at molecule k + atom-length molecule-length - k new-line
unless find new-molecules test-molecule [
new-molecules: join/with new-molecules test-molecule
write "added " write/line test-molecule
;write/line new-molecules
increment number-of-molecules
]
increment all-options
]
]
inline: take/line file-handle
]
close file-handle
write "number " WRITE/LINE number-of-molecules
write/line all-options
Part 2.
This one needed to just do simplifications on the given molecule and hope everything works out, which it did.
Meta [
file: "2015-day-19.part2.meta"
purpose: "Solve AoC task 2015 day 19 part 2"
]
; ANSWER
molecule: "CRnCaCaCaSiRnBPTiMgArSiRnSiRnMgArSiRnCaFArTiTiBSiThFYCaFArCaCaSiThCaPBSiThSiThCaCaPTiRnPBSiThRnFArArCaCaSiThCaSiThSiRnMgArCaPTiBPRnFArSiThCaSiRnFArBCaSiRnCaPRnFArPMgYCaFArCaPTiTiTiBPBSiThCaPTiBPBSiRnFArBPBSiRnCaFArBPRnSiRnFArRnSiRnBFArCaFArCaCa
CaSiThSiThCaCaPBPTiTiRnFArCaPTiBSiAlArPBCaCaCaCaCaSiRnMgArCaSiThFArThCaSiThCaSiRnCaFYCaSiRnFYFArFArCaSiRnFYFArCaSiRnBPMgArSiThPRnFArCaSiRnFArTiRnSiRnFYFArCaSiRnBFArCaSiRnTiMgArSiThCaSiThCaFArPRnFArSiRnFArTiTiTiTiBCaCaSiRnCaCaFYFArSiThCaPTiBPTiBCaSiThSiRnM
gArCaF"
molecule-length: count molecule
number-of-steps: 0
molecule-marker: "*"
rules: ""
infile: to file! "./input-2015-day-19.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
inline: take/line file-handle
while not is-tail file-handle [
if is-empty inline [
write/line "All replacements read"
break
]
;write "inline: " write/line inline
atom-length: either find/here at inline 2 " " [1][2]
;write "atom-length: " write/line atom-length
to-replace: copy cut inline atom-length
;write "to-replace: " write/line to-replace
replace-with: find/tail inline "=> "
;write/line molecule-length
rules: join/with join/with join/with join/with rules
replace-with molecule-marker to-replace
new-line
inline: take/line file-handle
]
close file-handle
save-rules: rules
;rules: {ThRnFAr*Al
;}
;molecule: "AlThRnFArBCa"
while molecule != "e" [
;for input, output in rules
while not is-tail rules [
found: find/tail rules new-line
length: (count rules) - (count found)
my-rule: copy cut rules length - 1
rules: skip rules length
cmr: count my-rule
to-place: find/tail my-rule "*"
to-replace: copy cut my-rule (cmr - 1 - count to-place)
ctr: to whole! count to-replace
while is-present: find molecule to-replace [
cip: count is-present
cm: count molecule
molecule: join/with join/with copy cut molecule (cm - cip) to-place
skip molecule (cm - cip + ctr)
increment number-of-steps
]
]
rules: save-rules
]
WRITE/LINE number-of-steps
Meta [
file: "2015-day-20.meta"
purpose: "Solve AoC task 2015 day 20 part 1"
]
; Answer is 786240
; Actual number is 34000000 but each elf is giving a tenfold
minimal-packages= 34000000
m= 10
let counts binary! minimal-packages * size-of whole!
d: divide minimal-packages m
housenumber: 0
limit: 2147483647 ; the use of this limit is dubious, as WHOLE! is limited anyway by this amount
let get-value whole! 0
for i d [
d-divided-by-i: divide d i
intermediate: either limit < d-divided-by-i [limit][d-divided-by-i] ; so the use of intermediate may be unneccesary
; by the limit posed on limit by its TYPE!
for j intermediate [
place: ((to whole! j) * i - 1) * size-of whole!
get-value: ((to whole! i) * m + (unportable as whole! at counts place))
unportable change/binary at counts place get-value
]
if minimal-packages <= unportable as whole! at counts (i - 1 * size-of whole!) [
housenumber: i
break
]
]
write/line housenumber
Because this is a short one I give the Part 2 as well.
Meta [
file: "2015-day-20.part2.meta"
purpose: "Solve AoC task 2015 day 20 part 2"
]
minimal-packages= 34000000
m= 11
let counts binary! minimal-packages * size-of whole!
d: divide minimal-packages m
housenumber: 0
limit: 50
let get-value whole! 0
for i d [
d-divided-by-i: divide d i
intermediate: either limit < d-divided-by-i [limit][d-divided-by-i]
for j intermediate [
place: ((to whole! j) * i - 1) * size-of whole!
get-value: ((to whole! i) * m + (unportable as whole! at counts place))
unportable change/binary at counts place get-value
]
if minimal-packages <= unportable as whole! at counts (i - 1 * size-of whole!) [
housenumber: i
break
]
]
write/line housenumber
The input format of this day is the best we can get as Meta programmers. It is in a valid format already. So this is a simple cut and paste excersize.
Hit Points: 109
Damage: 8
Armor: 2
The only issue is the space in "Hit Points" and I do not like those caps, even though Meta will not mind!
But the task itself is more complex. Most solvers use a brute force approach, which will likely be the best approach.
Meta [
file: "2015-day-21.meta"
purpose: "Solve AoC task 2015 day 22 part 1"
]
; ANSWER
; End Boss data
hit-points: 109
damage: 8
armor: 2
boss-hit-points: 109
boss-dmg: 8
boss-def: 2
let [weapons-cost weapons-dmg] binary! 5
poke weapons-cost 1 8
poke weapons-dmg 1 4
poke weapons-cost 2 10
poke weapons-dmg 2 5
poke weapons-cost 3 25
poke weapons-dmg 3 6
poke weapons-cost 4 40
poke weapons-dmg 4 7
poke weapons-cost 5 74
poke weapons-dmg 5 8
let [armour-cost armour-def] binary! 6
poke armour-cost 1 0
poke armour-def 1 0
poke armour-cost 2 13
poke armour-def 2 1
poke armour-cost 3 31
poke armour-def 3 2
poke armour-cost 4 53
poke armour-def 4 3
poke armour-cost 5 75
poke armour-def 5 4
poke armour-cost 6 102
poke armour-def 6 5
let [rings-cost rings-def rings-dmg] binary! 8
poke rings-cost 1 0
poke rings-def 1 0
poke rings-dmg 1 0
poke rings-cost 2 0
poke rings-def 2 0
poke rings-dmg 2 0
poke rings-cost 3 25
poke rings-def 3 0
poke rings-dmg 3 1
poke rings-cost 4 50
poke rings-def 4 0
poke rings-dmg 4 2
poke rings-cost 5 100
poke rings-def 5 0
poke rings-dmg 5 3
poke rings-cost 6 20
poke rings-def 6 1
poke rings-dmg 6 0
poke rings-cost 7 40
poke rings-def 7 2
poke rings-dmg 7 0
poke rings-cost 8 80
poke rings-def 8 3
poke rings-dmg 8 0
let [ring-1 ring-2] binary! 28
; 12 13 14 15 16 17 18
; 23 24 25 26 27 28
; 34 35 36 37 38
; 45 46 47 48
; 56 57 58
; 67 68
; 78
change/repeat ring-1 7 28
change/repeat ring-1 6 27
change/repeat ring-1 5 25
change/repeat ring-1 4 22
change/repeat ring-1 3 18
change/repeat ring-1 2 12
change/repeat ring-1 1 7
change/repeat ring-2 8 28
poke ring-2 1 2
poke ring-2 2 3
poke ring-2 3 4
poke ring-2 4 5
poke ring-2 5 6
poke ring-2 6 7
poke ring-2 8 3
poke ring-2 9 4
poke ring-2 10 5
poke ring-2 11 6
poke ring-2 12 7
poke ring-2 14 4
poke ring-2 15 5
poke ring-2 16 6
poke ring-2 17 7
poke ring-2 19 5
poke ring-2 20 6
poke ring-2 21 7
poke ring-2 23 6
poke ring-2 24 7
poke ring-2 26 7
cheapest-win: 9999
player-hp: 100
for weapon 5[
for armour 6 [
for ringindex 28 [
r1: pick ring-1 ringindex
r2: pick ring-2 ringindex
player-dmg: (to whole! pick weapons-dmg weapon) + (pick rings-dmg r1) + pick rings-dmg r2
player-def: (to whole! pick armour-def armour) + (pick rings-def r1) + pick rings-def r2
cost: (to whole! pick weapons-cost weapon) + (pick armour-cost armour) +
(pick rings-cost r1) + pick rings-cost r2
if (pd: player-dmg - boss-def) < 1 [pd: 1]
if (bd: boss-dmg - player-def) < 1 [bd: 1]
pm: hit-points / pd
bm: player-hp / bd
if pm <= bm[
;write " pd: " write pd write " bd: " write/line bd
;write "pm: " write pm write " bm: " write/line bm
if cost < cheapest-win[
;write "weapon: " write weapon
;write " armour: " write armour
;write " r1: " write r1 write " r2: " write/line r2
;write " player-dmg: " write player-dmg
;write " player-def: " write/line player-def
;write "cheapest was: " write cheapest-win
;write " now cost: " write/line cost
cheapest-win: cost
]
]
;][
; if cost > max_cost[
; max_cost = cost
; ]
]
]
]
WRITE/LINE cheapest-win
For Part 2 we need the cost when still losing, the changes are commented out in previous source.
This was the last outstanding task I had left. Didn't really have a clue for how this could be done in a efficient way.
Turned out the solution used by virtually all solvers was doing enough random runs and see what the results of the winning games were.
The input data, Boss data from input is already in a Meta / REBOL format (almost)
Hit Points: 51
damage: 9
Meta [
file: "2015-day-22.meta"
purpose: "Solve AoC task 2015 day 22 part 1"
]
; Magic Missile costs 53 mana. It instantly does 4 damage.
; Drain costs 73 mana. It instantly does 2 damage and heals you for 2 hit points.
; Shield costs 113 mana. It starts an effect that lasts for 6 turns. While it is active, your armor is increased by 7.
; Poison costs 173 mana. It starts an effect that lasts for 6 turns. At the start of each turn while it is active, it deals the boss 3 damage.
; Recharge costs 229 mana. It starts an effect that lasts for 5 turns. At the start of each turn while it is active, it gives you 101 new mana.
; Run for 1'000'000 times with random spells casted, then hopefully the best order of using the spells
; should be in there.
; This is the preferred solution by practically all solvers.
let spell-cost binary! 5
poke spell-cost 1 53
poke spell-cost 2 73
poke spell-cost 3 113
poke spell-cost 4 173
poke spell-cost 5 229
random/seed now
least-mana-spent: 100'000
win-games: 0
for i 1000000 [
; reset the games initial values for boss and player
boss-hit-points: 51
boss-damage: 9
hit-points: 50
mana: 500
mana-spent: 0
poison-active: 0
recharge-active: 0
shield-active: 0
player-wins?: True
; A game takes maximum of 50 turns
for turn 50 [
if mana-spent > least-mana-spent [
player-wins?: false
break
]
if poison-active > 0[
boss-hit-points: boss-hit-points - 3
decrement poison-active
if boss-hit-points <= 0[
break
]
]
if recharge-active > 0 [
mana: mana + 101
decrement recharge-active
]
if shield-active > 0 [
decrement shield-active
]
either is-odd turn [ ; Player turn
while True [
random-byte: random 255
while random-byte > 254 [
random-byte: random 255
]
chosen-spell: 1 + modulo random-byte 5
cost: pick spell-cost chosen-spell
if any [all [cost = 113 shield-active > 0 ]
all [cost = 173 poison-active > 0 ]
all [cost = 229 recharge-active > 0 ]
][
continue
][
break
]
]
if cost = 53 [
boss-hit-points: boss-hit-points - 4
mana: mana - cost
mana-spent: mana-spent + cost
]
if cost = 73 [
boss-hit-points: boss-hit-points - 2
hit-points: hit-points + 2
mana: mana - cost
mana-spent: mana-spent + cost
]
if cost = 113 [
shield-active: 6
mana: mana - cost
mana-spent: mana-spent + cost
]
if cost = 173 [
poison-active: 6
mana: mana - cost
mana-spent: mana-spent + cost
]
if cost = 229 [
recharge-active: 5
mana: mana - cost
mana-spent: mana-spent + cost
]
][ ; Boss turn
hit-points: hit-points - boss-damage
if shield-active > 0 [
hit-points: hit-points + 7
]
]
; Test here if fight is over now
if mana <= 0 [
player-wins?: false
break
]
if hit-points <= 0 [
player-wins?: false
break
]
if boss-hit-points <= 0 [
break
]
]
if player-wins? [
increment win-games
if mana-spent < least-mana-spent [
least-mana-spent: mana-spent
]
]
]
write/line least-mana-spent
write/line win-games
Last bug found: I did not write the LEAST, but instead I wrote the LAST one found.
This was a very nice task and very suitable to use Meta for.
Meta [
file: "2015-day-23.meta"
purpose: "Solve AoC task 2015 day 23 part 1"
]
infile: to file! "./input-2015-day-23.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
program: ""
inline: ""
linenumber: 0
LINE-PREFIX="L"
LINE-PREFIX-ZERO= "L0"
FILL-OUT-SPACES= " "
inline: take/line file-handle
while not is-tail file-handle [
increment linenumber
program: (program | join/with either linenumber < 10 [LINE-PREFIX-ZERO][LINE-PREFIX] |
join/with form linenumber | join/with inline | join/with FILL-OUT-SPACES |
join/with new-line)
inline: take/line file-handle
]
;write/line program
close file-handle
;part 1:
a: 0
;part 2:
;a: 1
b: 0
programcounter: 1
let offset binary! 50
maximum-counter: 48
;save: 0
; process program
while programcounter <= maximum-counter [
; inc
; increment save
; if save > 200 [break]
fetch-line: join/with either programcounter < 10 [LINE-PREFIX-ZERO][LINE-PREFIX] form programcounter
programline: copy cut find/tail program fetch-line 10
; write fetch-line write " " write/line programline
set-programcounter: true
if find/here programline "inc" [
either find/here at programline 5 "a" [
increment a
][
increment b
]
]
if find/here programline "tpl" [
a: a * 3
]
if find/here programline "hlf" [
a: divide a 2
]
if find/here programline "jmp" [
jump-amount: to whole8! copy cut at programline 5 3
; write "JUMP AMOUNT: " write jump-amount write " pc before: " write programcounter
programcounter: programcounter + jump-amount
; write " pc after: " write programcounter
; write " used string " write copy cut at programline 5 3 write/line "<<"
; write/line programline
set-programcounter: false
]
if find/here programline "jio" [ ; jump IF ONE not ODD!!!
if a = 1 [
jump-amount: to whole8! copy cut at programline 8 3
programcounter: programcounter + jump-amount
set-programcounter: false
]
]
if find/here programline "jie" [
if is-even a [
jump-amount: to whole8! copy cut at programline 8 3
programcounter: programcounter + jump-amount
set-programcounter: false
]
]
if set-programcounter [
increment programcounter
]
]
write/line b
Part 2
In this code you can still see the changes for part 2. Also you can see how to use a variable 'save' to limit the program from fully executing which can be useful in debugging.
For a group to equal the third of the weight of the whole group, which is 516 in my case, 5 numbers could be enough, for the highest are together 533. But yes that is an odd number and 516 is an even number so the group must have 6 items at least, or 8 or 10, for all 28 given numbers are odd!
We must seek out all combinations of 6 items with total weight of a third. We do not need to check if the remaining packages can be split up in equal parts as well. They probably can be anyway, so only if the answer is wrong this must be considered. It appears it is not important.
Meta [
file: "2015-day-24.meta"
purpose: "Solve AoC task 2015 day 24 part 1"
]
infile: to file! "./input-2015-day-24.txt"
Either file-handle= try OPEN infile [
write/line "Processing data.."
][
write/line "Not able to open input file"
bye
]
CHOOSE-FROM= 28
let combinations binary! 6
for index 6 [
poke combinations index 7 - index
]
let packages binary! 28
change/repeat packages 0 28
input-total: 0
position: 0
inline: take/line file-handle
while not is-tail file-handle [
package-size: to whole! inline
increment position
unportable change/binary at packages position to byte! package-size
input-total: input-total + package-size
inline: take/line file-handle
]
close file-handle
NEEDED-WEIGHT= input-total / 3
let quantum-entanglement natural64! 0
least-quantum-entanglement: 99'999'999'999
success-combinations: 0
; Run through generated combinations
number-combinations: 1
next-combination?: True
while next-combination? [
; The new combination is ready here to compute total score
this-total: (to whole! unportable as byte! at packages pick combinations 1)
+ (to whole! unportable as byte! at packages pick combinations 2)
+ (to whole! unportable as byte! at packages pick combinations 3)
+ (to whole! unportable as byte! at packages pick combinations 4)
+ (to whole! unportable as byte! at packages pick combinations 5)
+ (to whole! unportable as byte! at packages pick combinations 6)
if this-total = NEEDED-WEIGHT [
quantum-entanglement: 1
for j 6 [
quantum-entanglement: quantum-entanglement *
unportable as byte! at packages pick combinations j
]
;break ; this would be okay if it was given the first one is the correct one already.
if quantum-entanglement < least-quantum-entanglement [
least-quantum-entanglement: quantum-entanglement
]
increment success-combinations
]
; determine the next combination
for combination-index 6 [
if CHOOSE-FROM > pick combinations combination-index [
new-combination: 1 + pick combinations combination-index
poke combinations combination-index new-combination
if combination-index > 1 [
for i combination-index [
increment new-combination
poke combinations (combination-index - i) new-combination
]
]
break
]
if (CHOOSE-FROM - 5) = pick combinations 6 [
next-combination?: False
break
]
]
increment number-combinations
]
write/line number-combinations
write/line success-combinations
write/line quantum-entanglement
write/line least-quantum-entanglement
Part 2.
So now the packages need to be split into 4 equal parts. The sum of the total stays the same so the new amount to equal is 387. This could be reached using 4 items at minimum, were it not that all my inputs are odd, so I have to use at least 5 items.
The algorithm to use will become simpler only using 5 of the boxes not 6. We also do not care to test if the remaining packages can be split up into equal parts.
Part 1. First we need to determine at which order our entry comes. Going down on column 1 we see an increase of the number that grows by 1 each step. Similar to the right.
row: *your row number*
column: *your column number*
order-number: 1
for t row - 1 [
order-number: order-number + t
]
for t column - 1 [
order-number: order-number + t + row
]
write/line order-number
I get a result of 18168397. Count has been verified.
The process needs to multiply the original input by 252533 each time and calculate the modulo of division by 33554393.
You can repeat this process all 18168397 times and get your answer.
Or you simply calculate (20151125 * (252533^18168397)) mod 33554393. Which is the way I prefer, because mathematics is not here to make life difficult but instead it will make your life much more easy!
The rule is A * B mod C is equivalent to (A mod C) * (B mod C) mod C, you can simplify A is it is larger than C, so can you do this with B and if the product of those again is larger than C you do it again modulo C.
This way you can simplify within much fewer steps than when you just calculate.
As 2^24 = 16777216 and 2^25 = 33554432 (That number is suspisciously close to that other number) we could use our spreadsheet again.
252533^18168397
=
252533^16777216
*
252533^1048576
*
252533^262144
*
252533^65536
*
252533^8192
*
252533^4096
*
252533^2048
*
252533^512
*
252533^64
*
252533^8
*
252533^4
*
252533^1
Taking that data from my spreadsheet
= 18645723 * 23718165 * 26590984 * 9909027 * 187772 * 13606385 * 15395155 * 3450670 * 21918150 * 14510688 * 909301 * 19569389 * 252533
And do not forget the original input
let n natural64! 20151125
n: modulo n * to natural64! 18645723 33554393 ; 16777216
n: modulo n * to natural64! 23718165 33554393 ; 1048576
n: modulo n * to natural64! 26590984 33554393 ; 262144
n: modulo n * to natural64! 9909027 33554393 ; 65535
n: modulo n * to natural64! 187772 33554393 ; 8192
n: modulo n * to natural64! 13606385 33554393 ; 4096
n: modulo n * to natural64! 15395155 33554393 ; 2048
n: modulo n * to natural64! 3450670 33554393 ; 512
n: modulo n * to natural64! 21918150 33554393 ; 64
n: modulo n * to natural64! 14510688 33554393 ; 8
n: modulo n * to natural64! 909301 33554393 ; 4
write/line n
Or you can opt for the brute force.
let code natural64! 20151125
for index 18168396 [
if index < 10 [WRITE index write " - " write/line code]
code: (code * (to natural64! 252533)) // 33554393
]
For part 2 you need to put in 49 stars!
![You have enough stars to [Start the Weather Machine].](../images/specials/adventofcode-2015-completed.png)
You have enough stars to [Start the Weather Machine].