Compare commits

..

25 Commits

Author SHA1 Message Date
efim
61abf66381 giving up for rest of AoC 2022 2022-12-31 15:33:45 +00:00
efim
f2c18830c2 yay, day 22. part 1 2022-12-31 14:41:30 +00:00
efim
5630acd513 day 25 part 1
unfortunately part 2 is closed until all other stars are collected.
oh, sad
2022-12-26 07:54:44 +00:00
efim
3abfbb53ca day 21, part 2 backward computation. that's hot 2022-12-25 14:54:34 +00:00
efim
f6799dd691 lets skip day 21 part 2! 2022-12-25 10:58:24 +00:00
efim
c2acd2f75a day 21 part 1, fun 2022-12-25 10:43:57 +00:00
efim
e062633074 day 20 part 2, yay 2022-12-25 09:56:18 +00:00
efim
281a0aebf4 day 20 part 2, yay 2022-12-25 09:40:10 +00:00
efim
974cc4993d day 20 kicking me with duplicates 2022-12-25 09:10:19 +00:00
efim
2eb4b5c0a5 at least part 1 of day 19 2022-12-24 12:45:54 +00:00
efim
bf52645d93 this is "optimization" 2022-12-24 10:11:53 +00:00
efim
83f65babdf not yet anything for day 19 2022-12-23 22:58:50 +00:00
efim
598500e289 day 18, part 2 complete, with a little bit ugly 2022-12-22 20:41:17 +00:00
efim
831f09c9cd day 18, part 2, not complete, before going ugly 2022-12-22 20:37:14 +00:00
efim
643bba2464 day 18, part 1, the simple one 2022-12-22 19:49:43 +00:00
efim
01d5c300d6 giving up on day 17 2022-12-20 20:34:07 +00:00
efim
69250daf63 day 16 part 2, quite stuck 2022-12-18 18:59:07 +00:00
efim
ae745dc0f2 day 17 part 1. ugh 2022-12-18 17:22:43 +00:00
efim
3126cd48ab day 16 monstrocity calculated overnight 2022-12-18 07:19:59 +00:00
efim
914abe5a1f day 16, well that was an ugly logical error 2022-12-17 15:32:11 +00:00
efim
293250c20b day 16, still not working.
trying out with smaller example.
AND. before refactoring by BAD BOOLEAN
2022-12-17 14:17:49 +00:00
efim
c2ea2ec16e day 15 part 2. using INTERVALS 2022-12-16 15:30:38 +00:00
efim
190382eddc day 15 p.1: scanners and beacons, bad solution 2022-12-16 12:13:37 +00:00
efim
6757e3ba23 day 14, part 2 - endless pyramid 2022-12-15 17:40:22 +00:00
efim
c82f5473ba day 14, falling sand part 1 2022-12-15 17:00:01 +00:00
44 changed files with 17053 additions and 0 deletions

147
day14-input.txt Normal file
View File

@@ -0,0 +1,147 @@
502,19 -> 507,19
523,100 -> 523,104 -> 519,104 -> 519,111 -> 528,111 -> 528,104 -> 526,104 -> 526,100
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
507,117 -> 521,117 -> 521,116
517,34 -> 522,34
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
510,75 -> 510,78 -> 505,78 -> 505,84 -> 518,84 -> 518,78 -> 515,78 -> 515,75
503,34 -> 508,34
501,15 -> 506,15
523,136 -> 523,138 -> 518,138 -> 518,145 -> 535,145 -> 535,138 -> 528,138 -> 528,136
513,113 -> 513,114 -> 527,114
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
523,136 -> 523,138 -> 518,138 -> 518,145 -> 535,145 -> 535,138 -> 528,138 -> 528,136
530,150 -> 535,150
526,133 -> 526,131 -> 526,133 -> 528,133 -> 528,129 -> 528,133 -> 530,133 -> 530,129 -> 530,133
523,100 -> 523,104 -> 519,104 -> 519,111 -> 528,111 -> 528,104 -> 526,104 -> 526,100
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
510,34 -> 515,34
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
510,75 -> 510,78 -> 505,78 -> 505,84 -> 518,84 -> 518,78 -> 515,78 -> 515,75
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
524,34 -> 529,34
498,46 -> 502,46
510,46 -> 514,46
509,19 -> 514,19
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
526,133 -> 526,131 -> 526,133 -> 528,133 -> 528,129 -> 528,133 -> 530,133 -> 530,129 -> 530,133
497,13 -> 502,13
504,46 -> 508,46
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
545,155 -> 545,157 -> 541,157 -> 541,160 -> 556,160 -> 556,157 -> 550,157 -> 550,155
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
510,75 -> 510,78 -> 505,78 -> 505,84 -> 518,84 -> 518,78 -> 515,78 -> 515,75
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
507,43 -> 511,43
523,100 -> 523,104 -> 519,104 -> 519,111 -> 528,111 -> 528,104 -> 526,104 -> 526,100
506,31 -> 511,31
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
510,75 -> 510,78 -> 505,78 -> 505,84 -> 518,84 -> 518,78 -> 515,78 -> 515,75
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
507,117 -> 521,117 -> 521,116
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
534,152 -> 539,152
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
495,19 -> 500,19
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
523,136 -> 523,138 -> 518,138 -> 518,145 -> 535,145 -> 535,138 -> 528,138 -> 528,136
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
527,152 -> 532,152
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
533,148 -> 538,148
510,75 -> 510,78 -> 505,78 -> 505,84 -> 518,84 -> 518,78 -> 515,78 -> 515,75
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
516,46 -> 520,46
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
545,155 -> 545,157 -> 541,157 -> 541,160 -> 556,160 -> 556,157 -> 550,157 -> 550,155
501,119 -> 501,120 -> 512,120 -> 512,119
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
512,25 -> 517,25
526,133 -> 526,131 -> 526,133 -> 528,133 -> 528,129 -> 528,133 -> 530,133 -> 530,129 -> 530,133
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
513,31 -> 518,31
526,133 -> 526,131 -> 526,133 -> 528,133 -> 528,129 -> 528,133 -> 530,133 -> 530,129 -> 530,133
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
520,31 -> 525,31
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
482,21 -> 482,22 -> 490,22
510,75 -> 510,78 -> 505,78 -> 505,84 -> 518,84 -> 518,78 -> 515,78 -> 515,75
498,17 -> 503,17
523,136 -> 523,138 -> 518,138 -> 518,145 -> 535,145 -> 535,138 -> 528,138 -> 528,136
545,155 -> 545,157 -> 541,157 -> 541,160 -> 556,160 -> 556,157 -> 550,157 -> 550,155
513,43 -> 517,43
523,100 -> 523,104 -> 519,104 -> 519,111 -> 528,111 -> 528,104 -> 526,104 -> 526,100
505,17 -> 510,17
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
509,28 -> 514,28
545,155 -> 545,157 -> 541,157 -> 541,160 -> 556,160 -> 556,157 -> 550,157 -> 550,155
537,150 -> 542,150
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
501,43 -> 505,43
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
501,119 -> 501,120 -> 512,120 -> 512,119
507,37 -> 511,37
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
523,100 -> 523,104 -> 519,104 -> 519,111 -> 528,111 -> 528,104 -> 526,104 -> 526,100
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
501,119 -> 501,120 -> 512,120 -> 512,119
510,40 -> 514,40
488,19 -> 493,19
482,21 -> 482,22 -> 490,22
494,15 -> 499,15
523,136 -> 523,138 -> 518,138 -> 518,145 -> 535,145 -> 535,138 -> 528,138 -> 528,136
526,133 -> 526,131 -> 526,133 -> 528,133 -> 528,129 -> 528,133 -> 530,133 -> 530,129 -> 530,133
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
526,133 -> 526,131 -> 526,133 -> 528,133 -> 528,129 -> 528,133 -> 530,133 -> 530,129 -> 530,133
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
545,155 -> 545,157 -> 541,157 -> 541,160 -> 556,160 -> 556,157 -> 550,157 -> 550,155
513,97 -> 513,89 -> 513,97 -> 515,97 -> 515,94 -> 515,97 -> 517,97 -> 517,94 -> 517,97 -> 519,97 -> 519,93 -> 519,97 -> 521,97 -> 521,88 -> 521,97 -> 523,97 -> 523,94 -> 523,97
523,136 -> 523,138 -> 518,138 -> 518,145 -> 535,145 -> 535,138 -> 528,138 -> 528,136
504,40 -> 508,40
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
526,133 -> 526,131 -> 526,133 -> 528,133 -> 528,129 -> 528,133 -> 530,133 -> 530,129 -> 530,133
523,100 -> 523,104 -> 519,104 -> 519,111 -> 528,111 -> 528,104 -> 526,104 -> 526,100
545,155 -> 545,157 -> 541,157 -> 541,160 -> 556,160 -> 556,157 -> 550,157 -> 550,155
516,28 -> 521,28
545,155 -> 545,157 -> 541,157 -> 541,160 -> 556,160 -> 556,157 -> 550,157 -> 550,155
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
491,17 -> 496,17
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
526,133 -> 526,131 -> 526,133 -> 528,133 -> 528,129 -> 528,133 -> 530,133 -> 530,129 -> 530,133
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
497,72 -> 497,63 -> 497,72 -> 499,72 -> 499,65 -> 499,72 -> 501,72 -> 501,71 -> 501,72 -> 503,72 -> 503,67 -> 503,72 -> 505,72 -> 505,63 -> 505,72 -> 507,72 -> 507,71 -> 507,72 -> 509,72 -> 509,70 -> 509,72 -> 511,72 -> 511,69 -> 511,72
523,100 -> 523,104 -> 519,104 -> 519,111 -> 528,111 -> 528,104 -> 526,104 -> 526,100
513,113 -> 513,114 -> 527,114
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
510,75 -> 510,78 -> 505,78 -> 505,84 -> 518,84 -> 518,78 -> 515,78 -> 515,75
488,59 -> 488,51 -> 488,59 -> 490,59 -> 490,52 -> 490,59 -> 492,59 -> 492,55 -> 492,59 -> 494,59 -> 494,52 -> 494,59 -> 496,59 -> 496,50 -> 496,59 -> 498,59 -> 498,58 -> 498,59 -> 500,59 -> 500,56 -> 500,59 -> 502,59 -> 502,56 -> 502,59 -> 504,59 -> 504,57 -> 504,59
541,152 -> 546,152
523,136 -> 523,138 -> 518,138 -> 518,145 -> 535,145 -> 535,138 -> 528,138 -> 528,136

385
day14-scratch.lisp Normal file
View File

@@ -0,0 +1,385 @@
;; https://adventofcode.com/2022/day/14
;; so, 2d space vertical and left-right. point from which sand falls down and lines (likely horizontal || vertical) that collide with falling sand
;; gathering input. i've only thought of doing initialization in two sweeps.
;;
;; one to get "leftmost" and "rightmost", top & bottom coords.
;; so that i'm putting it all into one class that has accessors that translate it to
;; ordinary 2d array
;;
;; sand is pouring from (500, 0) - (column, row) - from
;; columns : left -> right
;; rows : top to bottom
;; top is already 0
;;
;; chars: #\. - empty space
;; #\# - stone
;; #\o - falling sand ; will not be actually stored I suppose
;; #\x - resting sand
(defclass arena ()
((grid :initarg :grid :initform (error "supply value for :grid"))
(leftmost :initarg :left :accessor leftmost)
(bottommost :initarg :bottom :accessor bottommost)
(rightmost :initarg :right :accessor rightmost)))
(defun make-arena (left right bottom)
(let ((cols-num (1+ (- right left)))
(rows-num (1+ bottom)))
(make-instance 'arena :left left :right right :bottom bottom
:grid (make-array (list rows-num cols-num)
:initial-element #\.))))
(make-array '(2 5) :initial-element "hello")
;; now. translation for coordinates, and in a way that would allow writing into place?
;; can i just defmethod getf for nonexistent place?
(defparameter *test-arena* (make-arena 100 110 7))
(setf (aref (slot-value *test-arena* 'grid) 0 4) #\*)
;; or just do through macros? nah, try functions first, it's just i liked idea of aref
;; (x y) -> (row col) in grid
(defun translate-coords (arena x y)
(list y (- x (leftmost arena))))
(destructuring-bind (rrow ccol) (translate-coords *test-arena* 104 2)
(list rrow ccol))
(defun get-place (arena x y)
(destructuring-bind (row col) (translate-coords arena x y)
(aref (slot-value arena 'grid) row col)))
(get-place *test-arena* 104 0)
(defun set-place (arena x y value)
(destructuring-bind (row col) (translate-coords arena x y)
(setf (aref (slot-value arena 'grid) row col) value)))
(set-place *test-arena* 104 1 #\&)
(slot-value *test-arena* 'grid)
;; ok. now funciton that would add lines from input?
(ql:quickload 'cl-ppcre)
(defun input-line-to-rock-coords (line)
(mapcar (lambda (coords) (mapcar #'parse-integer (cl-ppcre:split "," coords)))
(cl-ppcre:split " -> " line)))
(input-line-to-rock-coords " 503,4 -> 502,4 -> 502,9 -> 494,9 ")
;; now. i want to do first pass and find leftmost, rightmost and bottommost
(defparameter *day14-input-file* "day14-test.txt")
(mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*))
;; now find flatten list in Alexandria
(ql:quickload 'alexandria)
(defparameter *test-input-flat-coords*
(alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*))))
;; well, it fully flattens it by default. maybe there it's configurable?
;; using destructuring of pairs would be better
(loop
for (x y) on *test-input-flat-coords*
by #'cddr
do (format t "x:~a y:~a~%" x y))
(loop
for (x y) on *test-input-flat-coords*
by #'cddr
minimize x
do (print x))
(loop
for (x y) on *test-input-flat-coords*
by #'cddr
minimize y
do (print y))
(loop
for (x y) on *test-input-flat-coords*
by #'cddr
collect x into x-es
collect y into y-es
finally (return (list (apply #'min x-es) (apply #'min y-es))))
;; this : I was forgetting :by #'cddr
;; here's limits
(let ((flat-coords
(alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*))
)))
(loop
for (x y) on flat-coords
by #'cddr
minimize x into leftmost
maximize x into rightmost
maximize y into bottommost
finally (return (list leftmost rightmost bottommost))))
;; next - build arena
;; building empty arena
(setq *test-arena*
(let ((flat-coords
(alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*)))))
(destructuring-bind (leftmost rightmost bottommost)
(loop
for (x y) on flat-coords
by #'cddr
minimize x into leftmost
maximize x into rightmost
maximize y into bottommost
finally (return (list leftmost rightmost bottommost)))
(make-arena leftmost rightmost bottommost))))
(slot-value *test-arena* 'grid)
;; now adding rock lines from coord list
'(((498 4) (498 6) (496 6)) ((503 4) (502 4) (502 9) (494 9)))
;; and one line is
(defparameter *test-rock-line-coords* '((498 4) (498 6) (496 6)))
(loop
for (x y) in *test-rock-line-coords*
do (format t "x:~a y:~a~%" x y))
;; can i take two at a time?
;; well, maybe use DO
(do* ((coords-list *test-rock-line-coords* (cdr coords-list))
(first-coords (first *test-rock-line-coords*) (first coords-list))
(second-coords (second *test-rock-line-coords*) (second coords-list)))
((not second-coords) "end")
(format t "~a -> ~a, in ~a~%" first-coords second-coords coords-list))
;; yup.
;; now in this DO i have "start point" -> "end point"
;; let's do separate function that
(let ((start-x 10)
(start-y 1)
(end-x 25)
(end-y 1))
(loop for x from start-x to end-x do
(loop for y from start-y to end-y do
(format t "(~a, ~a), " x y)))
(terpri))
(let ((start-x 100)
(start-y 2)
(end-x 100)
(end-y 11))
(loop for x from start-x to end-x do
(loop for y from start-y to end-y do
(format t "(~a, ~a), " x y)))
(terpri))
;; that works
(defun put-rock-line (arena start-x end-x start-y end-y)
(loop for x from start-x to end-x do
(progn
(loop for y from start-y to end-y
do (set-place arena x y #\#)))))
;; yas.
;; now do this for each pair of coords
(put-rock-line *test-arena* 101 109 1 1)
(setq *test-arena* (make-arena 100 110 7))
(slot-value *test-arena* 'grid)
(get-place *test-arena* 101 1)
(put-rock-line *test-arena* 101 109 1 1)
(set-place *test-arena* 101 1 #\#)
(set-place *test-arena* 102 1 #\#)
;; copy over previous per-2-coords-loop:
(loop
for (x y) in *test-rock-line-coords*
do (format t "x:~a y:~a~%" x y))
;; can i take two at a time?
;; well, maybe use DO
(do* ((coords-list *test-rock-line-coords* (cdr coords-list))
(first-coords (first *test-rock-line-coords*) (first coords-list))
(second-coords (second *test-rock-line-coords*) (second coords-list)))
((not second-coords) "end")
(destructuring-bind ((start-x start-y) (end-x end-y))
(list first-coords second-coords)
(put-rock-line *test-arena* start-x end-x start-y end-y) ))
;; yes
(array-dimension (make-array '(3 10)) 1)
(get-place *test-arena* 101 3)
(get-place *test-arena* 0 0)
(slot-value *test-arena* 'grid)
;; oh, it doesn't work when numbers are in wrong order.
;; ugh the LOOP for i from 9 to 3
;; how do i deal with that?
(defun put-rock-line (arena start-x end-x start-y end-y)
(let ((start-x (min start-x end-x))
(end-x (max start-x end-x))
(start-y (min start-y end-y))
(end-y (max start-y end-y)))
(loop for x from start-x to end-x do
(progn
(loop for y from start-y to end-y
do (set-place arena x y #\#))))))
(defun put-rock-chain (arena rock-coods-chain)
(do* ((coords-list rock-coods-chain (cdr coords-list))
(first-coords (first rock-coods-chain) (first coords-list))
(second-coords (second rock-coods-chain) (second coords-list)))
((not second-coords) "end")
(destructuring-bind ((start-x start-y) (end-x end-y))
(list first-coords second-coords)
(put-rock-line arena start-x end-x start-y end-y) )))
(defun put-rock-lines (arena rock-coords-lines)
(loop
for rock-coord-line in rock-coords-lines
do (put-rock-chain arena rock-coord-line)))
(defparameter *test-input-coords-chains* nil)
(setq *test-input-coords-chains*
(mapcar #'input-line-to-rock-coords
(uiop:read-file-lines *day14-input-file*)))
(slot-value *test-arena* 'grid)
(put-rock-lines *test-arena* *test-input-coords-chains*)
;; i think this works.
;; seems to be the complete initialization
;; now for the sand simulation part.
;; again, envision this as lots of loops
;; inner loop - one new sand
;; created at (500, 0), starts dropping
;; either until out-of-bounds
;; or settled by checks of lower-part
;; out-of-bounds is air
;; and . char is air
(defun is-point-air (x y arena)
(or (eq #\. (get-place arena x y))
(not (get-place arena x y))))
(is-point-air 498 4 *test-arena*)
(is-point-air 498 3 *test-arena*)
(is-point-air 500 0 *test-arena*)
(is-point-air 502 3 *test-arena*)
(is-point-air 502 4 *test-arena*)
(defun sand-check-next-move (sand-x sand-y arena)
(let* ((next-y (1+ sand-y))
(possible-next-steps (list (list sand-x next-y)
(list (1- sand-x) next-y)
(list (1+ sand-x) next-y))))
(first (remove-if-not (lambda (coords)
(is-point-air (first coords) (second coords) arena))
possible-next-steps))))
;; let's return next step or nil if it rests
(sand-check-next-move 502 3 *test-arena*)
(get-place *test-arena* 501 4)
(get-place *test-arena* 503 4)
(sand-check-next-move 500 7 *test-arena*)
(sand-check-next-move 500 8 *test-arena*)
(get-place *test-arena* 501 4)
(get-place *test-arena* 503 4)
(aref (slot-value *test-arena* 'grid) 0)
(array-storage-vector (slot-value *test-arena* 'grid))
(defun out-of-bounds (x y arena)
(not (get-place arena x y)))
;; well, this seems to work
;; now the one grain loop
(let ((arena *test-arena*))
(do*
((prev-coords nil sand-coords)
(sand-coords '(500 0) (sand-check-next-move
(first sand-coords) (second sand-coords) arena)))
((or (not sand-coords) ; sand rests
(out-of-bounds (first sand-coords) (second sand-coords) arena)) ; end condition - rest or out of bounds
(when (not sand-coords)
(set-place arena (first prev-coords) (second prev-coords) #\x)))
(format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)))
(init-arena)
(slot-value *test-arena* 'grid)
(not (get-place *test-arena* 500 0 ))
(set-place *test-arena* 500 0 #\x)
(defun drop-sand-unit (arena)
(do*
((prev-coords nil sand-coords)
(sand-coords '(500 0) (sand-check-next-move
(first sand-coords) (second sand-coords) arena)))
((or (not sand-coords) ; sand rests
(out-of-bounds (first sand-coords) (second sand-coords) arena)) ; end condition - rest or out of bounds
(when (not sand-coords)
(set-place arena (first prev-coords) (second prev-coords) #\x)))
(format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)))
;; ok, i got inner loop
;; now what? run that loop until the grain of sand ends up our of bounds
;; what are we calculating?
;; "how many units of sand come to rest until they start falling into abyss"
;; so. do ?
(let ((arena *test-arena*))
(do ((sand-units 0 (1+ sand-units))
(drop-result (drop-sand-unit arena) (drop-sand-unit arena)))
((not drop-result)
sand-units)))
(slot-value *test-arena* 'grid)
(defun drop-sand-unit-abyss (arena)
(do ((sand-units 0 (1+ sand-units))
(drop-result (drop-sand-unit arena) (drop-sand-unit arena)))
((not drop-result)
sand-units)))
;;; PART 2
;; let's not do floor infinite.
;; let's just give it enough left-to-right?
;; since the triangle is 2 right angle triangles, then bottom is 2x height
;; so, let's add 4x height of the floor?
;;
;; new bottommost =
(+ 2 bottommost)
;; new leftmost =
(min leftmost
(- 500 (* 2 bottommost)))
;; new rightmost =
(max rightmost
(+ 500 (* 2 bottommost)))
;; and add new rock-line?
;; just through function that adds a rockline
(slot-value *test-arena* 'grid)
;; and now i'd like a more compact printing.
;; how'd i do that?
;; surely there's a way to get access ot a slice of the 2d array?
(let* ((arena *test-arena*)
(array (slot-value arena 'grid)))
(dotimes (row (array-dimension array 0))
(dotimes (col (array-dimension array 1))
(format t "~a" (aref array row col)))
(terpri)))
(drop-sand-unit *test-arena*)

2
day14-test.txt Normal file
View File

@@ -0,0 +1,2 @@
498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9

198
day14.lisp Normal file
View File

@@ -0,0 +1,198 @@
;; https://adventofcode.com/2022/day/14
(ql:quickload 'cl-ppcre)
(ql:quickload 'alexandria)
;; (defparameter *day14-input-file* "day14-test.txt")
(defparameter *day14-input-file* "day14-input.txt")
(defclass arena ()
((grid :initarg :grid :initform (error "supply value for :grid"))
(leftmost :initarg :left :accessor leftmost)
(bottommost :initarg :bottom :accessor bottommost)
(rightmost :initarg :right :accessor rightmost)))
(defun make-arena (left right bottom)
(let ((cols-num (1+ (- right left)))
(rows-num (1+ bottom)))
(make-instance 'arena :left left :right right :bottom bottom
:grid (make-array (list rows-num cols-num)
:initial-element #\.))))
(defparameter *test-arena* nil)
;; (x y) -> (row col) in grid
(defun translate-coords (arena x y)
(list y (- x (leftmost arena))))
(defun get-place (arena x y)
(destructuring-bind (row col) (translate-coords arena x y)
(when (and (<= 0 row) (<= 0 col)
(< row (array-dimension (slot-value arena 'grid) 0))
(< col (array-dimension (slot-value arena 'grid) 1))
)
(aref (slot-value arena 'grid) row col))))
(defun set-place (arena x y value)
(destructuring-bind (row col) (translate-coords arena x y)
(when (and (<= 0 row) (<= 0 col)
(< row (array-dimension (slot-value arena 'grid) 0))
(< col (array-dimension (slot-value arena 'grid) 1))
)
(setf (aref (slot-value arena 'grid) row col) value))))
(defun input-line-to-rock-coords (line)
(mapcar (lambda (coords) (mapcar #'parse-integer (cl-ppcre:split "," coords)))
(cl-ppcre:split " -> " line)))
(defparameter *test-input-flat-coords* nil)
(defun put-rock-line (arena start-x end-x start-y end-y)
(let ((start-x (min start-x end-x))
(end-x (max start-x end-x))
(start-y (min start-y end-y))
(end-y (max start-y end-y)))
(loop for x from start-x to end-x do
(progn
(loop for y from start-y to end-y
do (set-place arena x y #\#))))))
(defun put-rock-lines (arena rock-coords-lines)
(loop
for rock-coord-line in rock-coords-lines
do (put-rock-chain arena rock-coord-line)))
(defparameter *test-input-coords-chains* nil)
(defun put-rock-chain (arena rock-coods-chain)
(do* ((coords-list rock-coods-chain (cdr coords-list))
(first-coords (first rock-coods-chain) (first coords-list))
(second-coords (second rock-coods-chain) (second coords-list)))
((not second-coords) "end")
(destructuring-bind ((start-x start-y) (end-x end-y))
(list first-coords second-coords)
(put-rock-line arena start-x end-x start-y end-y) )))
;; reinit things
;; (init-arena)
(defun init-arena ()
(setq *test-input-flat-coords*
(alexandria:flatten (mapcar #'input-line-to-rock-coords
(uiop:read-file-lines *day14-input-file*))))
;; building empty arena
(setq *test-arena*
(let ((flat-coords
(alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*)))))
(destructuring-bind (leftmost rightmost bottommost)
(loop
for (x y) on flat-coords
by #'cddr
minimize x into leftmost
maximize x into rightmost
maximize y into bottommost
finally (return (list leftmost rightmost bottommost)))
(make-arena leftmost rightmost bottommost))))
(setq *test-input-coords-chains*
(mapcar #'input-line-to-rock-coords
(uiop:read-file-lines *day14-input-file*)))
; this is second step of initialization
(put-rock-lines *test-arena* *test-input-coords-chains*))
(defun is-point-air (x y arena)
(or (eq #\. (get-place arena x y))
(not (get-place arena x y))))
(defun sand-check-next-move (sand-x sand-y arena)
(let* ((next-y (1+ sand-y))
(possible-next-steps (list (list sand-x next-y)
(list (1- sand-x) next-y)
(list (1+ sand-x) next-y))))
(first (remove-if-not (lambda (coords)
(is-point-air (first coords) (second coords) arena))
possible-next-steps))))
(defun out-of-bounds (x y arena)
(not (get-place arena x y)))
(defun drop-sand-unit (arena)
(do*
((prev-coords nil sand-coords)
(sand-coords '(500 0) (sand-check-next-move
(first sand-coords) (second sand-coords) arena)))
((or (not sand-coords) ; sand rests
(out-of-bounds (first sand-coords) (second sand-coords) arena)) ; end condition - rest or out of bounds
(when (or (not sand-coords)
(equal prev-coords '(500 0))) ; if sand rests at entry point
(set-place arena (first prev-coords) (second prev-coords) #\x)))
;; (format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)
))
(defun drop-sand-unit-abyss (arena)
(do ((sand-units 0 (1+ sand-units))
(drop-result (drop-sand-unit arena) (drop-sand-unit arena)))
((not drop-result)
sand-units)))
;; ok, could return arena
(init-arena)
(drop-sand-unit-abyss *test-arena*) ; 901
;;; PART 2
(defun init-arena-2 ()
(setq *test-input-flat-coords*
(alexandria:flatten (mapcar #'input-line-to-rock-coords
(uiop:read-file-lines *day14-input-file*))))
;; building empty arena
(setq *test-arena*
(let ((flat-coords
(alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*)))))
(destructuring-bind (leftmost rightmost bottommost)
(loop
for (x y) on flat-coords
by #'cddr
minimize x into leftmost
maximize x into rightmost
maximize y into bottommost
finally (return (list leftmost rightmost bottommost)))
(let ((new-bottommost (+ 2 bottommost))
(new-leftmost (min leftmost
(- 500 (* 2 bottommost))))
(new-rightmost (max rightmost
(+ 500 (* 2 bottommost)))))
(make-arena new-leftmost new-rightmost new-bottommost)))))
;; and put floor
(let ((floor-y (bottommost *test-arena*))
(floor-x-start (leftmost *test-arena*))
(floor-x-end (rightmost *test-arena*)))
(put-rock-line *test-arena* floor-x-start floor-x-end floor-y floor-y))
(setq *test-input-coords-chains*
(mapcar #'input-line-to-rock-coords
(uiop:read-file-lines *day14-input-file*)))
; this is second step of initialization
(put-rock-lines *test-arena* *test-input-coords-chains*))
;; rewriting previous. otherwise endless loop
(defun drop-sand-unit (arena)
(do*
((prev-coords '(500 0) sand-coords)
(sand-coords (sand-check-next-move 500 0 arena)
(sand-check-next-move
(first sand-coords) (second sand-coords) arena)))
((or (not sand-coords) ; sand rests
(out-of-bounds (first sand-coords) (second sand-coords) arena)) ; end condition - rest or out of bounds
(when (and (not sand-coords)
(not (equal prev-coords '(500 0)))) ; if sand rests
(set-place arena (first prev-coords) (second prev-coords) #\x)))
;; (format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)
))
(init-arena-2)
(print (1+ (drop-sand-unit-abyss *test-arena*)))

33
day15-input.txt Normal file
View File

@@ -0,0 +1,33 @@
Sensor at x=2302110, y=2237242: closest beacon is at x=2348729, y=1239977
Sensor at x=47903, y=2473047: closest beacon is at x=-432198, y=2000000
Sensor at x=2363579, y=1547888: closest beacon is at x=2348729, y=1239977
Sensor at x=3619841, y=520506: closest beacon is at x=2348729, y=1239977
Sensor at x=3941908, y=3526118: closest beacon is at x=3772294, y=3485243
Sensor at x=3206, y=1564595: closest beacon is at x=-432198, y=2000000
Sensor at x=3123411, y=3392077: closest beacon is at x=2977835, y=3592946
Sensor at x=3279053, y=3984688: closest beacon is at x=2977835, y=3592946
Sensor at x=2968162, y=3938490: closest beacon is at x=2977835, y=3592946
Sensor at x=1772120, y=2862246: closest beacon is at x=2017966, y=3158243
Sensor at x=3283241, y=2619168: closest beacon is at x=3172577, y=2521434
Sensor at x=2471642, y=3890150: closest beacon is at x=2977835, y=3592946
Sensor at x=3163348, y=3743489: closest beacon is at x=2977835, y=3592946
Sensor at x=2933313, y=2919047: closest beacon is at x=3172577, y=2521434
Sensor at x=2780640, y=3629927: closest beacon is at x=2977835, y=3592946
Sensor at x=3986978, y=2079918: closest beacon is at x=3998497, y=2812428
Sensor at x=315464, y=370694: closest beacon is at x=-550536, y=260566
Sensor at x=3957316, y=3968366: closest beacon is at x=3772294, y=3485243
Sensor at x=2118533, y=1074658: closest beacon is at x=2348729, y=1239977
Sensor at x=3494855, y=3378533: closest beacon is at x=3772294, y=3485243
Sensor at x=2575727, y=210553: closest beacon is at x=2348729, y=1239977
Sensor at x=3999990, y=2813525: closest beacon is at x=3998497, y=2812428
Sensor at x=3658837, y=3026912: closest beacon is at x=3998497, y=2812428
Sensor at x=1551619, y=1701155: closest beacon is at x=2348729, y=1239977
Sensor at x=2625855, y=3330422: closest beacon is at x=2977835, y=3592946
Sensor at x=3476946, y=2445098: closest beacon is at x=3172577, y=2521434
Sensor at x=2915568, y=1714113: closest beacon is at x=2348729, y=1239977
Sensor at x=729668, y=3723377: closest beacon is at x=-997494, y=3617758
Sensor at x=3631681, y=3801747: closest beacon is at x=3772294, y=3485243
Sensor at x=2270816, y=3197807: closest beacon is at x=2017966, y=3158243
Sensor at x=3999999, y=2810929: closest beacon is at x=3998497, y=2812428
Sensor at x=3978805, y=3296024: closest beacon is at x=3772294, y=3485243
Sensor at x=1054910, y=811769: closest beacon is at x=2348729, y=1239977

481
day15-scratch.lisp Normal file
View File

@@ -0,0 +1,481 @@
;; https://adventofcode.com/2022/day/15
;;
;; oh, wow. i can already imagine the second part of the task
;; so. for arrangements of (sensor closest-beacon)
;; i need to figure out which points are out of rangle for all sensors?
;; where "range" is distance between sensor and the closest-beacon
;;
;; so for each sensor also store distance, and each sensor should be able to answer query for point
;; whether it disproves existence of a beacone there
;; then for ( POINTS x SENSORS ) computations i'll be able to mark all points that aren't covered.
;;
;; doesn't seem like too much
(ql:quickload 'cl-ppcre)
;; poor man's parsing
(rest (mapcar (lambda (str)
(parse-integer str :junk-allowed t))
(cl-ppcre:split "="
"Sensor at x=2, y=18: closest beacon is at x=-2, y=15")))
;; manhattan distance : https://en.wikipedia.org/wiki/Taxicab_geometry
;; sum of abs of coord-diffs
(defclass point ()
((x :initarg :x :reader x)
(y :initarg :y :reader y)))
(defmethod print-object ((obj point) stream)
(print-unreadable-object (obj stream :type t)
(with-slots (x y)
obj
(format stream "x:~a y:~a" x y))))
(defparameter *test-point-1*
(make-instance 'point :x 1 :y 19))
(defparameter *test-point-2*
(make-instance 'point :x -2 :y -20))
(defmethod manh-dist ((one point) (two point))
(+ (abs (- (x one) (x two)))
(abs (- (y one) (y two)))))
(manh-dist *test-point-1* *test-point-2*)
;; i guess this is right
(defclass sensor ()
((self-coord :initarg :self :reader self-coord)
(beacon-coord :initarg :beacon :reader beacon-coord)
(covered-dist :initarg :dist :reader covered-dist)))
(defun make-sensor (sens-x sens-y beac-x beac-y)
(let* ((sensor (make-instance 'point :x sens-x :y sens-y))
(beacon (make-instance 'point :x beac-x :y beac-y))
(dist (manh-dist sensor beacon)))
(make-instance 'sensor :self sensor :beacon beacon :dist dist)))
(defmethod print-object ((obj sensor) stream)
(print-unreadable-object (obj stream :type t)
(with-slots (self-coord beacon-coord covered-dist)
obj
(format stream "at: ~a, linked to: ~a, covering dist: ~a"
self-coord beacon-coord covered-dist))))
(defparameter *test-sensor* (make-sensor 2 18 -2 15))
(defmethod can-have-unknown-beacon-p ((p point) (s sensor))
(> (manh-dist p (self-coord s))
(covered-dist s)))
(manh-dist *test-point-1* (self-coord *test-sensor*))
(can-have-unknown-beacon-p *test-point-1* *test-sensor*)
(manh-dist *test-point-2* (self-coord *test-sensor*))
(can-have-unknown-beacon-p *test-point-2* *test-sensor*)
;; ok. now read in all sensors?
;; and then for line with specified 'y'
;; and from leftmost to rightmost S or B for each point ask each sensor if possible
;; to have an unknown beacon, if any says "no" - then no
;; otherwise - count
(defparameter *day15-input-file* "day15-test.txt")
(defun line-to-coords (line)
(rest (mapcar (lambda (str)
(parse-integer str :junk-allowed t))
(cl-ppcre:split "=" line))))
(defparameter *day15-sensors-list* nil)
(setq *day15-sensors-list*
(mapcar (lambda (coords-list)
(apply #'make-sensor coords-list))
(mapcar #'line-to-coords (uiop:read-file-lines *day15-input-file*))))
;; next - find lovest x and highest x
;; but then i guess i'd also want lovest and highest y overall
;; that's neat
(loop
for sensor in *day15-sensors-list*
minimize (x (self-coord sensor)) into xs
minimize (x (beacon-coord sensor)) into xs
maximize (x (self-coord sensor)) into xm
maximize (x (beacon-coord sensor)) into xm
minimize (y (self-coord sensor)) into ys
minimize (y (beacon-coord sensor)) into ys
maximize (y (self-coord sensor)) into ym
maximize (y (beacon-coord sensor)) into ym
finally (return (list xs xm ys ym)))
;; (-2 25 0 22)
;; now for line y=10 check all x and count how many -for-all- sensors allow new point
(defun all-sensors-allow-for-hidden-beacon (point sensors)
(macroexpand `(and ,@(mapcar (lambda (sensor) (can-have-unknown-beacon-p point sensor))
sensors))))
(defun all-sensors-allow-for-hidden-beacon (point sensors)
(not (position nil (mapcar (lambda (sensor) (can-have-unknown-beacon-p point sensor))
sensors))))
;; well, do i have to write my own function for AND ?
(when (all-sensors-allow-for-hidden-beacon *test-point-2* *day15-sensors-list*)
1)
(when (all-sensors-allow-for-hidden-beacon *test-point-1* *day15-sensors-list*)
1)
;; count how many ARE covered
(loop
for x from -2 to 25
count (not (all-sensors-allow-for-hidden-beacon
(make-instance 'point :x x :y 10)
*day15-sensors-list*)))
;; on the image it's from -2 and till 24, so should be 27, if counting 0
;; well. we're counting posistions "wher beacon can't possibly exist"
;; so removing points which _are_ beacons?
;;
;; and - range needs to be extended significantly, no?
;; what would be enough?
;; doubling into each direction?
(defmethod points-equal ((left point) (right point))
(and (= (x left) (x right))
(= (y left) (y right))))
(points-equal (make-instance 'point :x 1 :y 1)
(make-instance 'point :x 1 :y 1))
(defun possible-to-have-beacon (point sensors)
(let ((all-checks
(mapcar (lambda (sensor)
(if (points-equal point (beacon-coord sensor))
'known-sensor
(can-have-unknown-beacon-p point sensor) ; single NIL means - not possible to have unknown
))
sensors)))
(or (not (position nil all-checks)) ; nil if all sensors allow (said T) presense of unknown beacons
(position 'known-sensor all-checks) ; exists known sensor
)))
;; beacon is possible : either sensor has beacon at that point
;; or position is out of the sensor range
;; but here's the thing. if sencor-beacon is at this point - need to short-circuit T
(possible-to-have-beacon *test-point-2* *day15-sensors-list*)
(possible-to-have-beacon *test-point-1* *day15-sensors-list*)
(possible-to-have-beacon (make-instance 'point :x -2 :y 15) *day15-sensors-list*)
;; i guess that works
;; count how many ARE covered
(loop
for x from -2 to 25
count (not (possible-to-have-beacon
(make-instance 'point :x x :y 10)
*day15-sensors-list*)))
;; ok.
;;
;; new idea:
;; have class for "not intersecting intervals"
;; with method to add ( ? remove ) new interval
;; in part 2 we're looking for points which are outside of all scanners
;; where "last beacon" can be
;; start of idea - distance goes by x and y simmetrically.
;; between line Y1 and beacon (X2 Y2) we can calculate Y2 - Y1,
;; if that is > than length covered - then knowingly 0 points covered by scanners
;; if htat is < that covered length : abs(Y2 - Y1) = diff
;; that diff will be covered into both sides to the left and to the right of the X2
;; (Y1 X2) will be exactly diff distance away.
;; so (length - diff) is by how much we can go to the left and right and still be with distance to beacon upto length
;; Interval [(x2-diff, y1) .. (x2+diff, y1)] are all points where "there can't be unkown beacons"
;;
;; and my idea is to operate on the point intervals.
;; start with "total interval" from 0 to 4M, i guess
;; then - for each beacon calculate Interval where "can't be unknown beacons"
;; and subtract them from the line
;;
;; without use of "per point" is best
;; so. want to have class, that stores non-intersecting intervals ( scala SortedMap would be good here )
;;
;; but ok, can be just ((start end) (start2 end2)) sorted by #'first after every operation
;; what would be algo for "removing interval"
;;
;; go though the increasing 'interval starts', find first that's > our-start
;; then check current interval and previous interval
;;
;; previous interval could have end that clips current-interval
;; at-which-we-stopped could clip "end" of current-interval
;; should i just have class for interval? nah, just method, since no need in type checking?
(defun subtract-interval (minuend subtrahend)
(destructuring-bind ((m-left m-right) (s-left s-right)) (list minuend subtrahend)
(let ((resulting-interval
(if (< m-left s-left)
(list ; minuend starts to the left
m-left (min m-right s-left))
(list ; minuend starts to the right
s-right m-right)
)))
(when (<= (first resulting-interval) (second resulting-interval)) ; >= to allow intervals [4 4]
resulting-interval))))
(subtract-interval '(1 100) '(0 101)) ; NIL correct
(subtract-interval '(1 100) '(10 20)) ; only one return value, incorrect
;; oh, but it can be that our subrahend fully devours "to the right" and we'd need to check "next to the right"
;; ugh
;; went to search and found 'cl-interval
(ql:quickload 'cl-interval)
(interval:make-interval :start 1 :end 100 )
;; this is not what i need?
(defparameter *some-tree*
(interval:make-tree ))
(interval:insert *some-tree* (interval:make-interval :start 1 :end 100) )
(interval:delete *some-tree* (interval:make-interval :start 10 :end 20) )
*some-tree*
(interval:find-all *some-tree* 11) ; nope deletion doesn't work like i want it
;; ugh. write it on my own
(defstruct ([] (:constructor [] (low high)))
(low 0.0 :type real)
(high 0.0 :type real))
(defmethod sub ((i1 []) (i2 []))
([] (- ([]-low i1) ([]-high i2))
(- ([]-high i1) ([]-low i2))))
(sub ([] 1 100) ([] 10 20)) ; ([] -19 90) that's bs
;;; ugh. this is somethign completely different
;; so, back to my function
;; should be able to return list of intervals. either one or two if split
(defun subtract-interval (minuend subtrahend)
(destructuring-bind ((m-left m-right) (s-left s-right)) (list minuend subtrahend)
(cond
((< m-right s-left) (list m-left m-right)) ; minuend fully to the left
((> m-left s-right) (list m-left m-right)) ; minuend fully to the right
((and (< m-left s-left)
(> m-right s-right)) ; minuend is around subtrahend
(list (list m-left (1- s-left))
(list (1+ s-right) m-right))) ; part before and after subtrahend
((and (>= m-left s-left)
(<= m-right s-right)) ; subtrahend consumes minuend
nil)
((< m-left s-left) ; minuend start to the left, but not subtrahend consumes all right part
(list m-left (1- s-left)))
((> m-right s-right) ; minuend has part to the right of subtrahend
(list (1+ s-right) m-right)))))
(subtract-interval '(1 100) '(0 101)) ; NIL correct
(subtract-interval '(1 100) '(10 20)) ; two intervals, correct
(subtract-interval '(1 20) '(10 30)) ; correct, had deducted 10
(subtract-interval '(10 30) '(1 20)) ; correct, had deducted 20
(subtract-interval '(25 30) '(1 20)) ; correct, not changed
(subtract-interval '(1 20) '(25 30)) ; correct not changed
(subtract-interval '(1 20) nil) ; correct not changed
;; ok. now what. have interval
'(0 4000000) ; and deduct from it found intervals.
; it would produce list of intervals
; so for each new interval - deduct from all
; then i'll have list of intervals, where "unknown beacon is possible"
;; now. hm.
;; loop. no. first function that for LINE-Y and BEACON-CENTER calculates "no-unkown-beacons" interval
(defun get-no-unknown-beacons-x-interval (line-y scanner)
(let* ((y-dist (abs (- line-y (y (self-coord scanner)))))
(x-slack (- (covered-dist scanner) y-dist))
(x-sc (x (self-coord scanner))))
(when (>= x-slack 0)
(list (- x-sc x-slack) (+ x-sc x-slack)))))
*test-sensor* ; x: 2, y: 18, dist: 7
(y (self-coord *test-sensor*))
(get-no-unknown-beacons-x-interval 18 *test-sensor*)
(get-no-unknown-beacons-x-interval 17 *test-sensor*)
(get-no-unknown-beacons-x-interval 19 *test-sensor*)
;; should be (-5 9)
(get-no-unknown-beacons-x-interval 11 *test-sensor*)
(manh-dist (make-instance 'point :x 2 :y 11) (self-coord *test-sensor*))
;; seems right
(get-no-unknown-beacons-x-interval 4 (make-sensor 1 1 2 2))
;; seems right
(get-no-unknown-beacons-x-interval 2 *test-sensor*)
;; yup
;; now. start with interval '(0 4000000)
;; list of that interval
;; when working on a line
;; get 'no-unknowns' interval for each scanner
;; then for each interval in the lists -
;; take it oud and put results of subtraction instead
(defun subtract-from-all (intervals subtrahend)
(mapcan (lambda (interval) (subtract-interval interval subtrahend))
intervals))
(subtract-from-all '((1 4000000)) '(5 15)) ; yay
(subtract-from-all '((1 10) (12 17) (20 25)) '(5 23)) ; yay
(subtract-from-all '((3 10) (12 17) (20 25)) '(1 40)) ; yay
(subtract-from-all '((3 10) (12 17) (20 25)) nil) ; yay
;; now looping.
;; we fix line, then for each scanner we calculate interval and update our intervals
;; in the end - if not NIL - then some points can have "unknown beacond"
;; let's figure out inner loop first
(defun line-unknown-intervals (y scanners max-x)
(do*
((rest-scanners scanners (cdr rest-scanners))
(scanner (first rest-scanners) (first rest-scanners))
(known-interval (get-no-unknown-beacons-x-interval y scanner)
(when scanner (get-no-unknown-beacons-x-interval y scanner)))
(intervals (subtract-from-all `((0 ,max-x)) known-interval)
(subtract-from-all intervals known-interval)))
((not scanner) intervals)
;; (format t "step, ~a intervals, after removing ~a; from ~a ~%" intervals known-interval scanner)
))
(line-unknown-intervals 11 (get-sensors-list "day15-test.txt") 20)
(line-unknown-intervals 10 (get-sensors-list "day15-test.txt") 20)
;; 2: (SUBTRACT-FROM-ALL ((0 2) 14 4000000) (-3 3))
;; why is that intervals get polluted
;;
;; anothre problem we don't include last scanner?
;;
;; and another problem. do we remove too little?
;; step, ((-40 11) (13 40)) intervals, after removing (12 12); from #<SENSOR at: #<POINT x:12 y:14>, linked to: #<POINT x:10 y:16>, covering dist: 4>
;; for line y=10, dist 4, sensor at <POINT x:12 y:14>, no all ok
;; so, proposed answer is x=14, y=11
;; which sensor precludes that in my process?
;; step, ((-40 10) (14 40)) intervals, after removing (11 13); from #<SENSOR at: #<POINT x:12 y:14>, linked to: #<POINT x:10 y:16>, covering dist: 4>
;; <SENSOR at: #<POINT x:12 y:14>, linked to: #<POINT x:10 y:16>, covering dist: 4>
;; for y=11. dist is 3. so 12+-1 right?
(manh-dist (make-instance 'point :x 12 :y 14)
(make-instance 'point :x 14 :y 11))
;; so here distance is 5. wtf.
;; so. y=11
;; sensor at <POINT x:12 y:14>
;; we spend 3 12+-1 wtf
;; OOOH. it's (14 14) - meaning X is 14
;; and Y is 11
;; crap
(subtract-from-all '((1 4000000)) '(3 13)) ; yay
;; using (format t "step, ~a intervals, after removing ~a ~%" intervals known-interval)
;; inside of DO loop
(subtract-from-all '((0 10) (14 400000)) '(3 13)) ; whoa
(subtract-interval '(14 400000) '(3 13)) ; correct not changed
;; well that's because in the "all below" i return not list of list
;; hello type safety, man
(defparameter *day-15-2-ans* nil)
(setq *day-15-2-ans*
(let ((sensors (get-sensors-list "day15-input.txt")))
(loop
for y from 1 to 4000000
for y-unknown-intervals = (line-unknown-intervals y sensors 4000000)
when y-unknown-intervals collect (list y y-unknown-intervals)
when (= 0 (mod y 10000)) do (format t "in step ~a~%" y))))
(print *day-15-2-ans*)
;; well, there are lots of "possible solutions", ugh
(defparameter *day-15-2-test* nil)
(setq *day-15-2-test*
(let ((sensors (get-sensors-list "day15-test.txt")))
(loop
for y from 0 to 20
for y-unknown-intervals = (line-unknown-intervals y sensors 20)
when y-unknown-intervals collect (list y y-unknown-intervals)
when (= 0 (mod y 1000)) do (format t "in step ~a~%" y))))
*day-15-2-test*
;; so, i do find the answer, but also lots of NON ANSWERS:
'((11 ((14 14))) (12 ((3 3))) (13 ((2 4))) (14 ((1 5))) (15 ((0 6)))
(16 ((0 7))) (17 ((0 8))) (18 ((0 7))) (19 ((0 6))) (20 ((0 5))))
;; for example :x 3 :y 12
;; it should have been thrown out. why not? which scanner should have covered it
(line-unknown-intervals 12 (get-sensors-list "day15-test.txt") 20)
;; for example (3 12) and (-2 15 #7) nope, ok
;; for example (3 12) and (8 7 #9) nope, ok
;; i need to automate it. for all scanners, find what? closest?
(let ((p (make-instance 'point :x 3 :y 12)))
(loop
for scanner in (get-sensors-list "day15-test.txt")
collect (list (manh-dist (self-coord scanner) p) (covered-dist scanner))))
;; so for 1st scanner, dist 7 and covered-dist is 7.
;; UGH
;; and
;; - step, ((0 20)) intervals, after removing (1 3); from #<SENSOR at: #<POINT x:2 y:18>, linked to: #<POINT x:-2 y:15>, covering dist: 7>
;; here it was all along
(subtract-from-all '((0 20)) '(1 3 ))
;; maybe that's bug of first iteration of DO* or something
;; it would be in "non-covered interval"
;; maybe i don't remove enough?
;; i should remove interval where all points "covered by the sensor"
;; do i want to draw that shit?
'(((-40 -8) (28 40)) ((-40 -7) (27 40)) ((-40 -6) (26 40)) ((-40 -5) (25 40))
((-40 -4) (24 40)) ((-40 -3) (23 40)) ((-40 -2) (22 40)) ((-40 -1) (23 40))
((-40 -2) (24 40)) ((-40 -3) (25 40)) ((-40 -4) (14 14) (26 40))
((-40 -3) (3 3) (27 40)) ((-40 -2) (2 4) (28 40)) ((-40 -1) (1 5) (29 40))
((-40 6) (28 40)) ((-40 7) (27 40)) ((-40 8) (26 40)) ((-40 7) (25 40))
((-40 6) (24 40)) ((-40 5) (24 40)))
(defun draw-line-def (line-intervals)
(format t "!")
(do*
((intervals line-intervals (cdr intervals))
(prev-interval nil interval)
(interval (first intervals) (first intervals)))
((not interval) nil)
;; (format t "iteration int: ~a; prev: ~a" interval prev-interval)
(when (not prev-interval)
(dotimes (i (first interval))
(format t ".")))
(when prev-interval
(dotimes (i (- (first interval) (second prev-interval)))
(format t ".")))
(dotimes (i (- (second interval) (first interval)))
(format t "#"))
)
(format t "!") (terpri)
)
(draw-line-def '((-40 -8) (28 40)))
;; ok, i have 'draw-line'
(loop for line-def in *day-15-2-test* do
(draw-line-def line-def))
;;
;; let's yolo
(2175292 ((2335771 2335771)))
(+ (* 2335771) 2175292)
;; that didn't work

14
day15-test.txt Normal file
View File

@@ -0,0 +1,14 @@
Sensor at x=2, y=18: closest beacon is at x=-2, y=15
Sensor at x=9, y=16: closest beacon is at x=10, y=16
Sensor at x=13, y=2: closest beacon is at x=15, y=3
Sensor at x=12, y=14: closest beacon is at x=10, y=16
Sensor at x=10, y=20: closest beacon is at x=10, y=16
Sensor at x=14, y=17: closest beacon is at x=10, y=16
Sensor at x=8, y=7: closest beacon is at x=2, y=10
Sensor at x=2, y=0: closest beacon is at x=2, y=10
Sensor at x=0, y=11: closest beacon is at x=2, y=10
Sensor at x=20, y=14: closest beacon is at x=25, y=17
Sensor at x=17, y=20: closest beacon is at x=21, y=22
Sensor at x=16, y=7: closest beacon is at x=15, y=3
Sensor at x=14, y=3: closest beacon is at x=15, y=3
Sensor at x=20, y=1: closest beacon is at x=15, y=3

151
day15.lisp Normal file
View File

@@ -0,0 +1,151 @@
;; https://adventofcode.com/2022/day/15
(ql:quickload 'cl-ppcre)
(defparameter *day15-input-file* "day15-test.txt")
(defclass point ()
((x :initarg :x :reader x)
(y :initarg :y :reader y)))
(defmethod print-object ((obj point) stream)
(print-unreadable-object (obj stream :type t)
(with-slots (x y)
obj
(format stream "x:~a y:~a" x y))))
(defmethod points-equal ((left point) (right point))
(and (= (x left) (x right))
(= (y left) (y right))))
(defmethod manh-dist ((one point) (two point))
(+ (abs (- (x one) (x two)))
(abs (- (y one) (y two)))))
(defclass sensor ()
((self-coord :initarg :self :reader self-coord)
(beacon-coord :initarg :beacon :reader beacon-coord)
(covered-dist :initarg :dist :reader covered-dist)))
(defun make-sensor (sens-x sens-y beac-x beac-y)
(let* ((sensor (make-instance 'point :x sens-x :y sens-y))
(beacon (make-instance 'point :x beac-x :y beac-y))
(dist (manh-dist sensor beacon)))
(make-instance 'sensor :self sensor :beacon beacon :dist dist)))
(defmethod print-object ((obj sensor) stream)
(print-unreadable-object (obj stream :type t)
(with-slots (self-coord beacon-coord covered-dist)
obj
(format stream "at: ~a, linked to: ~a, covering dist: ~a"
self-coord beacon-coord covered-dist))))
(defmethod can-have-unknown-beacon-p ((p point) (s sensor))
(> (manh-dist p (self-coord s))
(covered-dist s)))
(defun line-to-coords (line)
(rest (mapcar (lambda (str)
(parse-integer str :junk-allowed t))
(cl-ppcre:split "=" line))))
(defun get-sensors-list (input-file-name)
(mapcar (lambda (coords-list)
(apply #'make-sensor coords-list))
(mapcar #'line-to-coords (uiop:read-file-lines input-file-name))))
(defun get-limits (sensors-list)
(loop
for sensor in sensors-list
minimize (x (self-coord sensor)) into xs
minimize (x (beacon-coord sensor)) into xs
maximize (x (self-coord sensor)) into xm
maximize (x (beacon-coord sensor)) into xm
minimize (y (self-coord sensor)) into ys
minimize (y (beacon-coord sensor)) into ys
maximize (y (self-coord sensor)) into ym
maximize (y (beacon-coord sensor)) into ym
finally (return (list xs xm ys ym))))
(defun possible-to-have-beacon (point sensors)
(let ((all-checks
(mapcar (lambda (sensor)
(if (points-equal point (beacon-coord sensor))
'known-sensor
(can-have-unknown-beacon-p point sensor) ; single NIL means - not possible to have unknown
))
sensors)))
(or (not (position nil all-checks)) ; nil if all sensors allow (said T) presense of unknown beacons
(position 'known-sensor all-checks) ; exists known sensor
)))
(defun count-certainly-not-beacons (input-file-name)
(let ((sensors (get-sensors-list input-file-name)))
(destructuring-bind (min-x max-x min-y max-y)
(get-limits sensors)
(let ((to-add-x (abs (- max-x min-x)))
;; (to-check-y 10)
(to-check-y 2000000)
)
(loop
for x from (- min-x to-add-x) to (+ max-x to-add-x)
count (not (possible-to-have-beacon
(make-instance 'point :x x :y to-check-y)
sensors))
do (format t "iterating for x:~a y:~a~%" x to-check-y))))))
(count-certainly-not-beacons "day15-test.txt")
;; (count-certainly-not-beacons "day15-input.txt")
;; well, that's just too slow
;; how do i rewrite it to make it faster?
;; i guess i could exclude the sensors which are too far away from the list?
;;
;; well, optimization here that we move by 1 point toward or away from sensor
;; so, we can kind of calculate when we'll be in it's range?
;; * in what amount of steps
;; ** whoa, org colors
;;
;; so.
;; PART 2 - just start search overnight?
;; for 0 to 4.000.000 by x and y?
;; and collect all such possible x and y?
;; nope, even if it were 5 minutes for 16mil,
;; so 2 minutes per 4 mil, then multiply by 4M - more than a day.
;; think better
(defun subtract-interval (minuend subtrahend)
(if (not subtrahend)
(list minuend) ; list of one interval
(destructuring-bind ((m-left m-right) (s-left s-right)) (list minuend subtrahend)
(cond
((< m-right s-left)
(list (list m-left m-right))) ; minuend fully to the left
((> m-left s-right)
(list (list m-left m-right))) ; minuend fully to the right
((and (< m-left s-left)
(> m-right s-right)) ; minuend is around subtrahend
(list (list m-left (1- s-left))
(list (1+ s-right) m-right))) ; part before and after subtrahend
((and (>= m-left s-left)
(<= m-right s-right)) ; subtrahend consumes minuend
nil)
((< m-left s-left) ; minuend start to the left, but not subtrahend consumes all right part
(list (list m-left (1- s-left)))) ; list of one interval
((> m-right s-right) ; minuend has part to the right of subtrahend
(list (list (1+ s-right) m-right)))))))
(defun get-no-unknown-beacons-x-interval (line-y scanner)
(let* ((y-dist (abs (- line-y (y (self-coord scanner)))))
(x-slack (- (covered-dist scanner) y-dist))
(x-sc (x (self-coord scanner))))
(when (>= x-slack 0)
(list (- x-sc x-slack) (+ x-sc x-slack)))))
(defun subtract-from-all (intervals subtrahend)
(mapcan (lambda (interval) (subtract-interval interval subtrahend))
intervals))

View File

@@ -0,0 +1,2 @@
Valve AA has flow rate=0; tunnels lead to valves BB
Valve BB has flow rate=1; tunnels lead to valves AA

51
day16-input.txt Normal file
View File

@@ -0,0 +1,51 @@
Valve NV has flow rate=5; tunnels lead to valves ZV, CG, YB, HX, OY
Valve NU has flow rate=6; tunnels lead to valves DA, MA, OA, DK
Valve VU has flow rate=0; tunnels lead to valves PS, FX
Valve JW has flow rate=0; tunnels lead to valves AA, MD
Valve RI has flow rate=0; tunnels lead to valves OY, DG
Valve DG has flow rate=9; tunnels lead to valves TG, RI, DF, EV, KW
Valve PH has flow rate=7; tunnels lead to valves KW, OW, LT, LZ
Valve KZ has flow rate=12; tunnels lead to valves ET, QV, CK, MS
Valve IX has flow rate=0; tunnels lead to valves TS, DO
Valve MS has flow rate=0; tunnels lead to valves LZ, KZ
Valve IL has flow rate=0; tunnels lead to valves DO, ET
Valve EJ has flow rate=20; tunnels lead to valves AV, JY
Valve DK has flow rate=0; tunnels lead to valves NU, CG
Valve YB has flow rate=0; tunnels lead to valves NV, PS
Valve OA has flow rate=0; tunnels lead to valves YA, NU
Valve DA has flow rate=0; tunnels lead to valves NU, RG
Valve KO has flow rate=0; tunnels lead to valves AA, TG
Valve RG has flow rate=4; tunnels lead to valves DF, DA, ZV, MD, LB
Valve MA has flow rate=0; tunnels lead to valves AA, NU
Valve OW has flow rate=0; tunnels lead to valves DO, PH
Valve KW has flow rate=0; tunnels lead to valves DG, PH
Valve DO has flow rate=14; tunnels lead to valves IX, IL, CZ, OW
Valve DF has flow rate=0; tunnels lead to valves RG, DG
Valve TG has flow rate=0; tunnels lead to valves DG, KO
Valve LB has flow rate=0; tunnels lead to valves RG, FX
Valve HX has flow rate=0; tunnels lead to valves AA, NV
Valve GB has flow rate=0; tunnels lead to valves AV, XK
Valve CG has flow rate=0; tunnels lead to valves DK, NV
Valve LT has flow rate=0; tunnels lead to valves AO, PH
Valve FX has flow rate=23; tunnels lead to valves LB, HY, VU
Valve ET has flow rate=0; tunnels lead to valves IL, KZ
Valve CK has flow rate=0; tunnels lead to valves UX, KZ
Valve LZ has flow rate=0; tunnels lead to valves PH, MS
Valve YA has flow rate=17; tunnels lead to valves JY, OA
Valve TS has flow rate=0; tunnels lead to valves NO, IX
Valve NO has flow rate=8; tunnel leads to valve TS
Valve XK has flow rate=24; tunnel leads to valve GB
Valve PS has flow rate=18; tunnels lead to valves EV, VU, YB
Valve AA has flow rate=0; tunnels lead to valves JW, HX, MA, KO
Valve MD has flow rate=0; tunnels lead to valves JW, RG
Valve JM has flow rate=19; tunnels lead to valves QV, HY, AO
Valve AV has flow rate=0; tunnels lead to valves EJ, GB
Valve AO has flow rate=0; tunnels lead to valves JM, LT
Valve JY has flow rate=0; tunnels lead to valves YA, EJ
Valve OY has flow rate=0; tunnels lead to valves NV, RI
Valve UX has flow rate=13; tunnels lead to valves CZ, CK
Valve HY has flow rate=0; tunnels lead to valves JM, FX
Valve EV has flow rate=0; tunnels lead to valves PS, DG
Valve CZ has flow rate=0; tunnels lead to valves UX, DO
Valve ZV has flow rate=0; tunnels lead to valves NV, RG
Valve QV has flow rate=0; tunnels lead to valves JM, KZ

128
day16-scratch-cl-graph.lisp Normal file
View File

@@ -0,0 +1,128 @@
;; https://adventofcode.com/2022/day/16
;; so. only idea i had is to build the graph, and then do random walk? ugh.
;; we could maybe potentially divide by 2 amount of recursion,
;;
;; since possible actions are
;; - go to next room
;; - open current valve & go to next room
;;
;; and that shared part is almost similar, but is 1 move shorter, but adds some turns of this valve being open
;; if i return info on which valves were open for how many turns from the recursion,
;; i could potentially calculate what is more - 1 less turn of all of these and + some amount of current room's valve
;; or just go to next turn.
;;
;; but this is kind of way too much, to wander aimlessly?
;; maybe I need to build closure, then could choose any desired vertice? and select only those which are not visited.
;; this seems much more sane
;;
;; maybe there's already good \ easy \ powerful graph library?
;;
;; i found two libraries for graphs.
;; https://cl-graph.common-lisp.dev/user-guide.html - this one seem to allow for calculating closures, and filtering.
;; (repo: https://github.com/gwkkwg/cl-graph )
;; so i could potentially filter the remaining graph for the walkthrough
;; https://github.com/kraison/graph-utils - this one visualization and primitives that could allow for writing algos
;;
;; i guess i'll try to install first. is it available in quicklisp?
;; (ql:quickload 'cl-graph)
(push #p"~/quicklisp/local-projects/cl-graph/" asdf:*central-registry*)
;; (ql:quickload "cl-graph")
(ql:quickload '(:cl-graph :moptilities))
(defclass my-graph (cl-graph:basic-graph)
())
(defparameter *test-graph* nil)
;; (:documentation "Stub for matrix based graph. Not implemented.")
;; OH NO
;; (cl-graph:add-vertex *test-graph* 6)
;; (cl-graph:vertex-count *test-graph*)
;; (cl-graph:graph->dot *test-graph* t)
;; (in-package #:cl-graph)
(in-package cl-user)
(make-graph 'basic-graph) ; still doesn' work
;; to allow export to DOT
;; https://github.com/gwkkwg/cl-graph/issues/12
;; (defclass* dot-graph (dot-graph-mixin graph-container)
;; ()
;; (:export-p t))
(let ((g (make-container 'dot-graph :default-edge-type :directed)))
(loop for (a b) in '((a b) (b c) (b d) (d e) (e f) (d f)) do
(add-edge-between-vertexes g a b))
(graph->dot g nil))
(setq *test-graph*
(let ((g (cl-graph:make-graph 'cl-graph:dot-graph)))
(loop for v in '(a b c d e) do
(cl-graph:add-vertex g v))
(loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
(cl-graph:add-edge-between-vertexes g v1 v2))
g))
(setq *test-graph*
(let ((g (make-graph 'graph-container)))
(loop for v in '(a b c d e) do
(add-vertex g v))
(loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
(add-edge-between-vertexes g v1 v2))
g))
(cl-graph:vertex-count *test-graph*)
(graph->dot *test-graph* nil)
(vertexes *test-graph*)
(make-graph-from-vertexes (vertexes *test-graph*))
(identity 1)
;; graph-container already subclass of basic-graph.
;; then why doesn't this method is dispatched?
(make-filtered-graph *test-graph* (lambda (v) t) )
;; maybe quicklisp doens't have a fresh enough version?
;; ok. how do i make quicklisp use cloned code?
;; well. too bad.
(cl-graph:make-graph-from-vertexes (cl-graph:vertexes *test-graph*))
(cl-graph:make-filtered-graph *test-graph* (lambda (v) t) )
((lambda (v) t) 1)
(ql:where-is-system :cl-graph)
;; => #P"/home/efim/quicklisp/dists/quicklisp/software/cl-graph-20171227-git/"
(ql:update-client)
(ql:update-all-dists)
;; Changes from quicklisp 2022-07-08 to quicklisp 2022-11-07:
(cl-graph:graph->dot *test-graph* nil)
;; required additional dependency
;; (ql:quickload '(:cl-graph :moptilities))
;; asdf system connections
;; https://github.com/gwkkwg/cl-graph/blob/3cb786797b24883d784b7350e7372e8b1e743508/cl-graph.asd#L84-L89
(setq *test-graph*
(let ((g (cl-graph:make-graph 'cl-graph:dot-graph)))
(loop for v in '(a b c d e) do
(cl-graph:add-vertex g v))
(loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
(cl-graph:add-edge-between-vertexes g v1 v2))
g))
(print (cl-graph:graph->dot *test-graph* nil))
(print (cl-graph:graph->dot
(cl-graph:make-filtered-graph *test-graph*
(lambda (v) (not (eq v 'a)))
:graph-completion-method nil)
nil))
;; well, that was all for nothing?
;; or do i still rather use that library?
;; because it would allow me to add data to vertices?
;;
;; and graph-utils allows for getting hashmap of all paths and lengts?

File diff suppressed because it is too large Load Diff

5
day16-simpler-test.txt Normal file
View File

@@ -0,0 +1,5 @@
Valve AA has flow rate=0; tunnels lead to valves BB
Valve BB has flow rate=1; tunnels lead to valves CC, EE
Valve CC has flow rate=1; tunnels lead to valves DD
Valve DD has flow rate=1; tunnels lead to valves EE
Valve EE has flow rate=1; tunnels lead to valves EE

10
day16-test.txt Normal file
View File

@@ -0,0 +1,10 @@
Valve AA has flow rate=0; tunnels lead to valves DD, II, BB
Valve BB has flow rate=13; tunnels lead to valves CC, AA
Valve CC has flow rate=2; tunnels lead to valves DD, BB
Valve DD has flow rate=20; tunnels lead to valves CC, AA, EE
Valve EE has flow rate=3; tunnels lead to valves FF, DD
Valve FF has flow rate=0; tunnels lead to valves EE, GG
Valve GG has flow rate=0; tunnels lead to valves FF, HH
Valve HH has flow rate=22; tunnel leads to valve GG
Valve II has flow rate=0; tunnels lead to valves AA, JJ
Valve JJ has flow rate=21; tunnel leads to valve II

58
day16.lisp Normal file
View File

@@ -0,0 +1,58 @@
;; https://github.com/kraison/graph-utils
(ql:quickload 'graph-utils)
(ql:quickload 'alexandria)
;;; reading in data
;; graph and hashmap from node name to flow and state
(defclass verticle-data ()
((flow :reader flow :initarg :flow)
(name :reader name :initarg :name)
(is-opened-p :accessor is-opened-p :initform t)))
(defmethod print-object ((obj verticle-data) stream)
(with-slots (name flow is-opened-p) obj
(format stream "~a with flow: ~a; is opened? ~a" name flow is-opened-p)))
(defun parse-integer-or-symbol (str)
(let ((maybe-int (parse-integer str :junk-allowed t)))
(if maybe-int
maybe-int
(intern (string-upcase str)))))
(defun parse-input-line (line)
(destructuring-bind (-valve source-name -has -flow -rate flow-rate
-tunnels -lead -to -valves &rest to-valve-names)
(mapcar #'parse-integer-or-symbol
(remove-if (lambda (str) (equal "" str)) (cl-ppcre:split "(,| |=)" line)))
(format t "from ~a with ~a; to ~a~%" source-name flow-rate to-valve-names)
(list source-name flow-rate to-valve-names)))
(defun read-file-data (filename graph vertices-data-map)
(loop
for line-struct in
(mapcar #'parse-input-line (uiop:read-file-lines filename))
do (put-struct-into-storages line-struct graph vertices-data-map)))
;;; calculations for part 1
(defun get-possible-next-vs (cur-node graph vertices-data-map shortest-paths time-remaining)
(loop
for (from . to)
being the hash-keys in shortest-paths using (hash-value dist)
for from-node = (graph-utils:lookup-node graph from)
for to-node = (graph-utils:lookup-node graph to)
for to-node-data = (gethash to-node vertices-data-map)
when (and (equal cur-node from-node)
(not (equal cur-node to-node))
(not (= 0 (flow to-node-data)))
(> time-remaining dist)
(is-opened-p to-node-data))
do (format t "from ~a to ~a dist: ~a. ~a~%" from-node to-node dist to-node-data)
when (and (equal cur-node from-node)
(not (equal cur-node to-node))
(not (= 0 (flow to-node-data)))
(> time-remaining dist)
(is-opened-p to-node-data))
collect (list to-node dist)))

1
day17-input.txt Normal file

File diff suppressed because one or more lines are too long

998
day17-scratch.lisp Normal file
View File

@@ -0,0 +1,998 @@
;; https://adventofcode.com/2022/day/17
;; so. cool.
;; one thought - i'd want to learn how to specify smaller argument types for optimizations
;; another - better think of optimizing checks
;; one more - reads from array should be faster, write new figure only after it comes to rest
;; thinking of checks. i could have separate methods that check 'possible left|right|down movement'
;; so. is there a cycle datastructure?
;; yes, but not in standart library, just cycle the list on itself
(defun circular (items)
(setf (cdr (last items)) items)
items)
(circular '(2 5 8 ))
(type-of '(1 . 7))
(typep '(1 . 7) '(cons fixnum fixnum))
(declaim (ftype (function (string (cons fixnum fixnum)) string) test-types))
(defun test-types (s tup)
(format nil "~a here, sup ~a~%" tup s))
(test-types "hello" '(1 . 4))
;; cool, but i want for separate arguments, so that it could be also used in defgeneric ?
(defun test-types-2 (ss tt str)
(declare (type string ss)
(type (cons fixnum string) tt)
;; (type 'string str)
)
(format t "~a ~a ~a" ss tt str))
(test-types-2 "hello" '(1 . "yy") 13)
;; that works!
;; and will probably work with defgeneric?
(defgeneric test-types-3 (obj str)
(declare (ignore str)))
;; doesn't work.
;; http://www.lispworks.com/documentation/HyperSpec/Body/m_defgen.htm
;; only allows "optimize" declaration
;; The special, ftype, function, inline, notinline, and declaration declarations are not permitted. Individual implementations can extend the declare option to support additional declarations.
;; OK
;; so, do i want to have separate classes and generic methods for checking left | bottom | right?
;; possibly, yes. and for printing
;; how do I select "anchor point"? from which i'd do checking?
;; well, HM. it could be always lowest point, i guess
;; how'd i do the check for moving left?
;; pass in array, and coord of the anchor, compute locally coords to check and check array content at that point
(defparameter *test-grid* nil)
(defun init-test-grid (height)
(declaim (type fixnum height))
(setq *test-grid*
(let*
((grid (make-array `(,height 7) :initial-element #\.))
(rownum (1- (array-dimension grid 0)))
(rowsize (array-dimension grid 1))
(row (make-array rowsize
:displaced-to grid
:displaced-index-offset (* rownum rowsize))))
(loop for i from 0 below (array-total-size row) do
(setf (aref row i) #\_))
grid))
nil)
(init-test-grid 200)
(defun print-grid (grid )
(let ((rows (array-dimension grid 0))
(rowsize (array-dimension grid 1)))
(terpri)
(loop for rownum from 0 below rows
do (let ((row-arr
(make-array rowsize
:displaced-to grid
:displaced-index-offset (* rownum rowsize))))
(format t "|~a|~%" (coerce row-arr 'string) )))
(terpri)))
(print-grid *test-grid* )
(print-grid *test-grid* ) ; well, it will hardly be helpful without specifying slice. if we're to drop Ks and Ms of stones
*test-grid*
;; (ql:quickload 'array-operations)
;; what's displaced array? would it be easy to get rows from multidimentional that way?
;; https://lispcookbook.github.io/cl-cookbook/arrays.html
;; The reduce function operates on sequences, including vectors (1D arrays), but not on multidimensional arrays.
;; To get around this, multidimensional arrays can be displaced to create a 1D vector.
;; Displaced arrays share storage with the original array, so this is a fast operation which does not require copying data:
(setf (aref (make-array 7 :displaced-to *test-grid*) 0) #\!)
;; if i just to :displaced-to it makes linear array of size 7 from index 0
;; now let's try to take third row
(setf (aref (make-array 7 :displaced-to *test-grid* :displaced-index-offset (* 2 7)) 0) #\?)
;; so :displaced-index-offset (* row cols) would get me correct row. and i could iterate over it and write into the array i suppose
;; how do i best loop over array?
(let*
((grid *test-grid*)
(rownum 2)
(rowsize (array-dimension grid 1))
(row (make-array rowsize
:displaced-to grid
:displaced-index-offset (* rownum rowsize))))
(loop for i from 0 below (array-total-size row) do
(setf (aref row i) #\%)))
*test-grid*
;; ok. and maybe i'd have to what? wrap grid in class that would translate the BOTTOM & Y into actual ROWNUM
;; ok, next problem - it can't really be infinite height, could need to shift down sometimes?
;; maybe every 1000 check 3 lines and if there's no vertical clearings - shift all down?
;;; GENERIC CODE for figures
(defclass figure () ())
;; maybe only for debugging and printing
(defgeneric all-points-from-hook (fig hook)) ; do i need that?
(defgeneric check-down-points (fig hook))
(defgeneric check-left-points (fig hook))
(defgeneric check-right-points (fig hook))
(defgeneric get-fig-top (fig hook)) ; for updating TOP
(defun points-into-array (points array ch)
(loop for (row . col) in points
do (setf (aref array row col) ch)))
(defmethod resting-into-array ((fig figure) array hook)
(declare (type (cons fixnum fixnum) hook)) ; also would like to declare array type
(loop for (row . col) in (all-points-from-hook fig hook)
do (setf (aref array row col) #\#))) ; save figure points into array. can be common for all figures
;; the figures start with their lovest point 3 units higher than TOP
;; and leftmost point 2 units to the right of left wall
;; so that i guess a good HOOK location
;; how would common code work? 0 .. 6 array
;; - generate hook position: (2 . (top + 3 + 1))
;; - check down,
;; if move - update hook, maybe update TOP & side-turn
;; else - call finalize into arry; go into same loop for next figure
;;
;; side move - read in direction, select check, apply result of the check to the Y coord of the HOOK
;; if it's DO loop. then what are the VARS:
;; figure, hook, iterations
;; is-resting is exit check, exit Sexp is finalizing TOP and INTO-ARR
;; then next figure loop could continue
;; also DO would count the iterations? could return the iterations, i guess
;; NOPE: we're counting amount of rocks that stopped
;; so, return TOP i guess, or owerwrite TOP that's set up in external LOOP
;; which takes FIGURE from infinite figure looped list
;;
;; ok, i guess
;; let's impelement one figure first, and then generic code. and check that
;;; so, now i could write the generic looping movement down?
;;; hmmm. i could code 2000 size array, but yup. probably should code row calculation immediately
;;; and maybe add ##### flor at the -1 ?
;; oh, come on, let's just make a big array, i have 32Gb of ram, shouldn't that be enough for one time run?
(defmethod is-point-free (hook array)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (row . col)
hook
(and (>= col 0)
(>= row 0)
(< row (array-dimension array 0))
(< col (array-dimension array 1))
(equal #\. (aref array row col)))))
;; really want to declare also array type
(is-point-free '(-1 . 2) *test-grid*)
(is-point-free '(0 . 2) *test-grid*)
(is-point-free '(9 . 2) *test-grid*)
(is-point-free '(1 . 9) *test-grid*)
(is-point-free '(2 . 0) *test-grid*)
(is-point-free '(2 . 1) *test-grid*)
(is-point-free '(2 . 2) *test-grid*)
(aref *test-grid* 2 2)
(equal #\. #\#)
(defmethod check-move ((fig figure) array hook direction)
(declare (type (cons fixnum fixnum) hook)
(type symbol direction))
(let* ((points-to-check (case direction
(DOWN (check-down-points fig hook))
(LEFT (check-left-points fig hook))
(RIGHT (check-right-points fig hook))
(t nil)))
(can-move (loop for check-point in points-to-check
always (is-point-free check-point array))))
(if (not can-move)
0
(case direction
(down 1)
(left -1)
(right 1)))))
;; https://sodocumentation.net/common-lisp/topic/1369/loop--a-common-lisp-macro-for-iteration thanks
(defun -check-fig (fig)
(let ((hook '(7 . 2)))
(init-test-grid 200)
(resting-into-array fig *test-grid* hook)
(print-grid *test-grid*)
(points-into-array (check-down-points fig hook) *test-grid* #\D)
(print-grid *test-grid*)
(points-into-array (check-left-points fig hook) *test-grid* #\L)
(print-grid *test-grid*)
(points-into-array (check-right-points fig hook) *test-grid* #\R)
(print-grid *test-grid*)
(init-test-grid 200)
))
;; hook is left point
;;; First figure class Horizontal Line
(defclass h-line (figure) ())
(defparameter *test-h-line* (make-instance 'h-line))
(defmethod all-points-from-hook ((fig h-line) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (row . col)
hook
(list (cons row col) (cons row (1+ col)) (cons row (+ 2 col)) (cons row (+ 3 col)))))
(all-points-from-hook *test-h-line* '(1 . 3 ))
;; well, check-down could be a generic method over figure with 'down-check-points' being generic methods specialized for figures. ok, i guess
;; row 0 should be top. The higher row - the lower thing is.
(defmethod check-down-points ((fig h-line) hook)
(declare (type (cons fixnum fixnum) hook))
(mapcar (lambda (coord)
(cons (1+ (car coord)) (cdr coord)))
(all-points-from-hook fig hook)))
(check-down-points *test-h-line* '(1 . 2))
(resting-into-array *test-h-line* *test-grid* '(2 . 1))
;; if DOWN is from zero, then LEFT is also from zero
(defmethod check-left-points ((fig h-line) hook)
(declare (type (cons fixnum fixnum) hook))
(list (cons (car hook) (1- (cdr hook)))))
(check-left-points *test-h-line* '(1 . 2)) ; (ROW . COL) that's quite prone to errors
;; if DOWN is from zero, then RIGHT is to zero
(defmethod check-right-points ((fig h-line) hook)
(declare (type (cons fixnum fixnum) hook))
(list (cons (car hook) (+ 4 (cdr hook)))))
(check-right-points *test-h-line* '(1 . 2))
(defmethod get-fig-top ((fig h-line) hook)
(declare (type (cons fixnum fixnum) hook))
(car hook)) ; for updating TOP
*test-grid*
(resting-into-array *test-h-line* *test-grid* '(0 . 0))
(resting-into-array *test-h-line* *test-grid* '(2 . 0))
;; (resting-into-array *test-h-line* *test-grid* '(3 . 4))
;; (defgeneric get-fig-top (fig hook)) ; for updating TOP
;;; now I could try to build a generic inner loop;
;; NEXT classes
;; WHELP. figure appears +4 from lowest point and +2 from leftmost
;; that means that hook for cross would be not a part of figure, but leftbottom corner
(defclass cross (figure) ())
(defmethod all-points-from-hook ((fig cross) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 2) . ,(1+ hook-col))
(,(1- hook-row) . ,hook-col) (,(1- hook-row) . ,(1+ hook-col)) (,(1- hook-row) . ,(+ 2 hook-col))
(,hook-row . ,(1+ hook-col))
)
)
) ; do i need that?
(defparameter *test-cross* (make-instance 'cross))
(init-test-grid 200)
(resting-into-array *test-cross* *test-grid* '(2 . 2))
(print-grid *test-grid*)
(defmethod check-down-points ((fig cross) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,hook-row . ,hook-col) (,hook-row . ,(+ 2 hook-col))
(,(1+ hook-row) . ,(1+ hook-col))
)
)
)
(defmethod check-left-points ((fig cross) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 2) . ,hook-col)
(,(1- hook-row) . ,(1- hook-col))
(,hook-row . ,hook-col)
)
)
)
(check-left-points *test-cross* '(18 . 2))
;; hook:(18 . 2); moveLEFT -> 0
;; so why is this?
(defmethod check-right-points ((fig cross) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 2) . ,(+ 2 hook-col))
(,(1- hook-row) . ,(+ 3 hook-col))
(,hook-row . ,(+ 2 hook-col))
)
)
)
(defmethod get-fig-top ((fig cross) hook)
(declare (type (cons fixnum fixnum) hook))
(- (car hook) 2) ; for updating TOP
)
(defclass bracket (figure) ())
(defparameter *test-bracket* (make-instance 'bracket))
(defmethod all-points-from-hook ((fig bracket) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 2) . ,(+ 2 hook-col))
(,(- hook-row 1) . ,(+ 2 hook-col))
(,hook-row . ,hook-col)(,hook-row . ,(+ 1 hook-col))(,hook-row . ,(+ 2 hook-col))
)
)
) ; do i need that?
(defmethod check-down-points ((fig bracket) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(+ hook-row 1) . ,hook-col)(,(+ hook-row 1) . ,(+ 1 hook-col))(,(+ hook-row 1) . ,(+ 2 hook-col))
)))
(defmethod check-left-points ((fig bracket) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 2) . ,(+ 1 hook-col))
(,(- hook-row 1) . ,(+ 1 hook-col))
(,hook-row . ,(- hook-col 1))
)))
(defmethod check-right-points ((fig bracket) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 2) . ,(+ 3 hook-col))
(,(- hook-row 1) . ,(+ 3 hook-col))
(,hook-row . ,(+ 3 hook-col))
)))
(defmethod get-fig-top ((fig bracket) hook)
(declare (type (cons fixnum fixnum) hook))
(- (car hook) 2) ; for updating TOP
)
(defclass v-line (figure) ())
(defparameter *test-v-line* (make-instance 'v-line))
(defmethod all-points-from-hook ((fig v-line) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 3) . ,hook-col)
(,(- hook-row 2) . ,hook-col)
(,(- hook-row 1) . ,hook-col)
(,hook-row . ,hook-col)
))
) ; do i need that?
(defmethod check-down-points ((fig v-line) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(+ hook-row 1) . ,hook-col)
))
)
(defmethod check-left-points ((fig v-line) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 3) . ,(- hook-col 1))
(,(- hook-row 2) . ,(- hook-col 1))
(,(- hook-row 1) . ,(- hook-col 1))
(,hook-row . ,(- hook-col 1))
))
)
(defmethod check-right-points ((fig v-line) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 3) . ,(+ hook-col 1))
(,(- hook-row 2) . ,(+ hook-col 1))
(,(- hook-row 1) . ,(+ hook-col 1))
(,hook-row . ,(+ hook-col 1))
))
)
(defmethod get-fig-top ((fig v-line) hook)
(declare (type (cons fixnum fixnum) hook))
(- (car hook) 3) ; for updating TOP
) ; for updating TOP
(defclass square (figure) ())
(defparameter *test-square* (make-instance 'square))
(defmethod all-points-from-hook ((fig square) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 1) . ,hook-col) (,(- hook-row 1) . ,(+ hook-col 1))
(,hook-row . ,hook-col) (,hook-row . ,(+ hook-col 1))
))
) ; do i need that?
(defmethod check-down-points ((fig square) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(+ hook-row 1) . ,hook-col) (,(+ hook-row 1) . ,(+ hook-col 1))
))
)
(defmethod check-left-points ((fig square) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 1) . ,(- hook-col 1))
(,hook-row . ,(- hook-col 1))
))
)
(defmethod check-right-points ((fig square) hook)
(declare (type (cons fixnum fixnum) hook))
(destructuring-bind (hook-row . hook-col)
hook
`(
(,(- hook-row 1) . ,(+ hook-col 2))
(,hook-row . ,(+ hook-col 2))
))
)
(defmethod get-fig-top ((fig square) hook)
(declare (type (cons fixnum fixnum) hook))
(- (car hook) 1) ; for updating TOP
) ; for updating TOP
;; COPY from above
;; how would common code work? 0 .. 6 array
;; - generate hook position: (2 . (top + 3 + 1))
;; - check down,
;; if move - update hook, maybe update TOP & side-turn
;; else - call finalize into arry; go into same loop for next figure
;;
;; side move - read in direction, select check, apply result of the check to the Y coord of the HOOK
;; if it's DO loop. then what are the VARS:
;; figure, hook, iterations
;; is-resting is exit check, exit Sexp is finalizing TOP and INTO-ARR
;; then next figure loop could continue
;; also DO would count the iterations? could return the iterations, i guess
;; NOPE: we're counting amount of rocks that stopped
;; so, return TOP i guess, or owerwrite TOP that's set up in external LOOP
;; which takes FIGURE from infinite figure looped list
(let* ((grid *test-grid*)
(top (1- (array-dimension grid 0))) ; max row with stone, get's smaller. 0 on the TOP
(figures (circular (list *test-h-line*)))
;; (fig *test-h-line*)
;; (hook (cons (- top 4) 2))
(lateral-moves (circular '(left right))))
;; outer loop is simple dotimes for amount of figures we want to drop
(dotimes (i 19)
;; let's do simple loop? returning when no longer can move down?
;; move down
(let ((hook (cons (- top 4) 2))
(fig (pop figures)))
(loop
;; first check lateral move (just after apperaing)
(let ((lateral-change (check-move fig grid hook (pop lateral-moves))))
(setq hook (cons (car hook) (+ lateral-change (cdr hook)))))
;; then check if possible to go down
(when (= 0 (check-move fig grid hook 'down))
;; all moves down done, update TOP and exit for next FIG
(setq top (min top (get-fig-top fig hook)))
(resting-into-array fig grid hook)
(return))
;; more moves down exist
;; do move down, and loop for the lateral change and possible exit
(setq hook (cons (1+ (car hook)) (cdr hook)))))))
(init-test-grid 200)
(print-grid *test-grid*)
*test-grid*
(let ((my-list '(1 2 3 4)))
`(returning ,(pop my-list) ,my-list))
;; well it seems to work maybe ok.
(defun print-intermediate-step (fig grid hook)
(let ((fig-points (all-points-from-hook fig hook)))
(points-into-array fig-points grid #\@)
(print-grid grid)
(points-into-array fig-points grid #\.)))
;; let's generalize this?
(defun try-dropping (figures lateral-moves
times grid height)
;; (print-grid grid)
(let* ((top (1- (array-dimension grid 0))) ; max row with stone, get's smaller. 0 on the TOP
(percent-index (floor (/ times 100)))
(running-percent-index 0)
(additional-count 0))
;; outer loop is simple dotimes for amount of figures we want to drop
(dotimes (i times)
;; fuck i forgot about my inverted TOP. it goes to 0
(when (< top (/ height 20))
;; ok. let's think about this.
;; my "TOP" for 10 rows is 8, overall indices start from 0
;; but "TOP" would be what?
;; it would start on 9. on the "already occupied" line
;; (by the floor, which we don't want to count)
;; so if TOP is 2, then 2 is "already occupied"
;; and only 2 left, so it's 7 elements
;; 10 - 2 - 1 how much we're need to count
;; which row i want to copy? the TOP, right?
;; if top is 9, then
;;
;; ok. let's count TOP at the moment of TRUNCATE
;; that would leave us with 1 unnecessary - the manual "floor"
(incf additional-count
(- (array-dimension *test-grid* 0) top 1))
(format t "Truncating~%" )
(setq grid (truncate-grid grid top height))
(setq top (1- (array-dimension grid 0)))
)
(when (= percent-index running-percent-index)
(setq running-percent-index 0)
(format t "One more: ~a%, , intermediate height: ~a; the step is ~a; the times is ~a~%"
(floor (* 100 (/ i times))) (- (array-dimension grid 0) top 1) i times)
)
(incf running-percent-index)
;; let's do simple loop? returning when no longer can move down?
;; move down
(let ((hook (cons (- top 4) 2))
(fig (pop figures)))
;; (print-intermediate-step fig grid hook)
(loop
;; first check lateral move (just after apperaing)
;; (print-intermediate-step fig grid hook)
(let* ((lat-move (pop lateral-moves))
(lateral-change (check-move fig grid hook lat-move)))
(setq hook (cons (car hook) (+ lateral-change (cdr hook))))
;; (format t "Looping for ~a figure ~a~%hook:~a; move~a -> ~a~%"
;; i fig hook lat-move lateral-change)
)
;; (print-intermediate-step fig grid hook)
;; then check if possible to go down
(when (= 0 (check-move fig grid hook 'down))
;; all moves down done, update TOP and exit for next FIG
(setq top (min top (get-fig-top fig hook)))
(resting-into-array fig grid hook)
(return))
;; more moves down exist
;; do move down, and loop for the lateral change and possible exit
(setq hook (cons (1+ (car hook)) (cdr hook))))))
(+ additional-count (- (array-dimension grid 0) top 1)))
;; (print-grid grid)
)
;; (init-test-grid 200)
;; (try-dropping (circular (list *test-h-line*)) (circular '(right left)) 9 *test-grid*)
;; (try-dropping (circular (list *test-h-line*)) (circular '(right)) 9 *test-grid*)
;; (try-dropping (circular (list *test-h-line*)) (circular '(right right left)) 9 *test-grid*)
;; (try-dropping (circular (list *test-cross* *test-h-line*))
;; (circular '(right right left)) 1 *test-grid*)
;; ;; seems maybe ok.
;; (try-dropping (circular (list *test-cross* *test-h-line*))
;; (circular '(right left left left left left)) 4 *test-grid*)
;; ;; now to implement the other figures. it's not quite fun
;; (try-dropping (circular (list *test-cross* *test-h-line*))
;; (circular '(left)) 1 *test-grid*) ; this is not right. no lateral moves done
;; (init-test-grid 200)
;; (try-dropping (circular (list *test-cross* *test-h-line*))
;; (circular '(right right left right)) 5 *test-grid*) ; this is not right. no lateral moves done
;; (try-dropping (circular (list *test-cross* *test-h-line*))
;; (circular '(left left right right right right left right)) 5 *test-grid*) ; this is not right. no lateral moves done
;; this is failure
;; ugh. this is failure. i'd rather take all points and shift them down \ left \ right
;; than do this manually
;; or - have better visual testing.
;; do (put-to-array) for left and for right and for down, and for figure
(-check-fig *test-cross*)
(-check-fig *test-h-line*)
(-check-fig (make-instance 'bracket))
(-check-fig *test-v-line*)
(-check-fig *test-square*)
;; ok, with this things would have to be better
;; and with this check fig, could at least visually check 3 other figures
;; (init-test-grid 20)
;; (try-dropping (circular (list *test-cross* *test-h-line* *test-bracket*))
;; (circular '(left left right right right right left right)) 5 *test-grid*) ; this is not right. no lateral moves done
;; ;; ok, i guess
;; (init-test-grid 100)
;; (try-dropping (circular (list *test-cross* *test-h-line* *test-bracket* *test-v-line*))
;; (circular '(left left right right right right left right)) 55 *test-grid*) ; this is not right. no lateral moves done
;; ok, maybe. but overall - ugh.
;; so, run the test data? oh, i havent' yet consumed the data. but it's in few lines,
;; right
(defparameter *test-lat-chars* ">>><<><>><<<>><>>><<<>>><<<><<<>><>><<>>")
(defparameter *test-lat-symbs*
(mapcar (lambda (ch) (case ch
(#\< 'LEFT)
(#\> 'RIGHT))) (coerce *test-lat-chars* 'list)))
(defparameter *shapes-order*
(list *test-h-line* *test-cross* *test-bracket* *test-v-line* *test-square*))
(defparameter *endless-shapes* (circular *shapes-order*))
(defparameter *endless-test-laterals* (circular *test-lat-symbs*))
;; now, i'd want to drop 2022 rocks. in example it should yield 3068 height
(typep 1 'fixnum)
(init-test-grid 10000)
(defparameter *test-run-result* 0)
;; (setq *test-run-result*
;; (try-dropping *endless-shapes*
;; *endless-test-laterals* 2022 *test-grid*)) ; this is not right. no lateral moves done
(print-grid *test-grid*)
;; ok my 7010 is to be deducted from 10000
(- (array-dimension *test-grid* 0) *test-run-result* 1)
;; well, something is wrong with the square
;; how could i test square without printing intermediate steps? well, i could add that, yeah
;;; let's add per-turn printing as well.
(init-test-grid 50)
;; (defparameter *test-run-result*
;; (try-dropping *endless-shapes*
;; *endless-test-laterals* 15 *test-grid*)) ; this is not right. no lateral moves done
;; well, let's run 2022 for my own input?
(defparameter *input-lat-chars* (uiop:read-file-string "day17-input.txt"))
(length (coerce *input-lat-chars* 'list))
(defparameter *input-lat-symbs*
(remove-if-not #'identity (mapcar (lambda (ch) (case ch
(#\< 'LEFT)
(#\> 'RIGHT))) (coerce *input-lat-chars* 'list))))
(print *input-lat-symbs*) ; cool, it has NIL in the end. why?
(defparameter *endless-input-laterals* (circular *input-lat-symbs*))
(type-of *input-lat-symbs*)
(typep *input-lat-symbs* 'list)
(length *input-lat-symbs* )
(init-test-grid 10000)
;; (defparameter *task-run-result*
;; (try-dropping *endless-shapes*
;; *endless-input-laterals* 2022 *test-grid*)) ; this is not right. no lateral moves done
(- (array-dimension *test-grid* 0) *task-run-result* 1)
;; PART 2
;; In the example above, the tower would be 1514285714288 units tall!
;; How tall will the tower be after 1000000000000 rocks have stopped?
;; so. let's print out intermediate? each 1% ?
;; 866549760 bytes available, 112800000000144 requested.
(floor (/ 112800000000144 866549760))
(floor (/ 910721024 1024 1024 1024)) ; available
(floor (/ 112800000000144 1024 1024 1024)) ; 105000 iGb requested
;; so, no
;; so, how'd i print report each 1% ?
(init-test-grid 10000)
(defparameter
*task-2-run-result* 0)
;; (setq *task-2-run-result*
;; (try-dropping *endless-shapes*
;; *endless-input-laterals* 2022 *test-grid*)) ; this is not right. no lateral moves done
(- (array-dimension *test-grid* 0) *task-2-run-result* 1)
(mod 7 4)
;; ok. i'd want to what? maybe every million size truncate?
;; when size get to 1M, get last row (height - 1?)
;; copy that last row to the first, add to the
(defun truncate-grid (grid top-row height)
(let*
((rownum (1- (array-dimension grid 0))) ; bottom row
(new-grid (make-array `(,height 7) :initial-element #\.))
(rowsize (array-dimension grid 1))
(row-bottom (make-array rowsize
:displaced-to new-grid
:displaced-index-offset (* rownum rowsize)))
(row-top (make-array rowsize
:displaced-to grid
:displaced-index-offset (* top-row rowsize))))
(gc :full t)
(loop for i from 0 below (array-total-size row-bottom) do
(setf (aref row-bottom i) (aref row-top i)))
new-grid))
;;; well, it will not work.
;; but let's try? first on test, and then maybe cancel
(/ 56000512 1024 1024) ; 54 Mb, that's WTF
(gc :full t)
(init-test-grid 100)
(defparameter *test-run-result* 0)
(setq *test-run-result* (try-dropping *endless-shapes*
*endless-test-laterals* 2022 *test-grid* 100)) ; this is not right. no lateral moves done
;; ok my 7010 is to be deducted from 10000
;; oh and one more transformation. hmmm hmmm
;; with enough grid 3068 - ok
;; when doing by 1000 - nok 3063. i'm missing rows somewhere
;;
;; i'm looking height when i'm truncating
(room t)
(init-test-grid 700)
(defparameter *test-run-result* 0)
(setq *test-run-result* (try-dropping *endless-shapes*
*endless-test-laterals* 2022 *test-grid* 700)) ; this is not right. no lateral moves done
;; but loosing 2 when do 1 truncating
;; 3087 when doing how many truncating?
;; for 500 600 700 wildly different numbers, so
;; yup. fuck if i only transfer last row - then hole in that last row is considered what?
;; yuck. i'd need to transfer serveral layers and still no guarantee
;;
;; how about i transfer 100 rows?
;; i'd init grid on my own, keep 100 rows below this is ugly as hell
;;
;; so, only good way is to actually trigger TRANSFER when there's possibility in
;; good enough floor
;;
;; and to know how to calculate correct amount of "negative space" below.
;; yuk.
;;; PART 2, again.
;; so the advice was to "find the loop"
;; loop would depend on 3 things that should match exactly: the current item, the current left-right movement, the last N (100, 200?) lines of the tower,
;; so that any falling figures would stop at same levels.
;; let's try to discover how could i compute hashes from collections and other things in CL?
;; maybe i could just use a triplet as a hash-key?
;; so, let's try with the hmmmm, i'd need to take first N of 'left and 'right, in order not to break hashmap
(defparameter *test-hashing-map* (make-hash-table :test #'equalp))
(setf (gethash '(left left right) *test-hashing-map*) 1)
(gethash '(left left right) *test-hashing-map*)
;; for lists it seems to work
;; then how about slices of the 2d array?
(defparameter *test-big-array* (make-array '(7 4) :initial-element #\.))
(defparameter *test-array-line-3* (make-array 4 :displaced-to *test-big-array* :displaced-index-offset (* 4 2)))
(defparameter *test-array-line-4* (make-array 4 :displaced-to *test-big-array* :displaced-index-offset (* 4 3)))
(setf (gethash *test-array-line-3* *test-hashing-map*) 111)
(gethash *test-array-line-4* *test-hashing-map*) ; nope, with arrays - not by contents, even when they are identical. so. i'd want a hashing funciton?
; for the contencts of the displaced array that takes 100 previous rows (including the top filled)
; so with #'equalp arrays seem to point to same thing?
; and if i change one array, then only by the new key value i retrieve the stored data.
; seems ok, i guess
(setf (aref *test-array-line-3* 3) #\?)
(sxhash *test-array-line-3*)
;; => 1193941381096739655 (61 bits, #x1091BB5C3EE91347)
(sxhash *test-array-line-4*)
(equalp *test-array-line-3* *test-array-line-4*) ; equal not good enough, with #'equalp - contents are checked
;; => 1193941381096739655 (61 bits, #x1091BB5C3EE91347)
;; ;; wait! it's the same!, but even after i changed contents?
;; so, i could do what? can i create list of left and right?
(defparameter *test-list-for-circ* '(left left right left left right right right))
(defparameter *test-circ* (copy-list '(left left right left left right right right)))
;; oh, this modifies in place, not nice
(circular *test-circ*) ; hehe, and calling it twice - it starts to look for the end. whops
(defparameter *test-0-offset-circ*
(subseq *test-circ* 0 (length *test-list-for-circ*))) ; seems ok.
(defparameter *test-2-offset-circ*
(progn
(pop *test-circ*)
(pop *test-circ*)
(subseq *test-circ* 0 (length *test-list-for-circ*))
))
*test-0-offset-circ*
*test-2-offset-circ*
;; i think that's ok.
;; so, gather these things into a list:
;; the offset 100 previous rows of the array
;; the current 'left 'right list subseq
;; and the current shape
;; could do this only on steps that start new shape
;; and check hashmap \ put into hashmap for future. for the previous line that had same structure.
;;
;; so, maybe 10M? 20M of lines to check?
;; create hashmap outside.
;; take initial slice of lateral-moves, mix with current-shape, and last 100 lines of grid (including top-filled-line-index)
;; create hashmap on the outside, with :test #'equalp
;;
;; now. if 0 is what? top. how would i calculate index from which to start TOP 100 lines?
;; if index 0, and i want 0th line - 0 * lineleng
;; so if index is 115 and i want TOP 5 it will be 111 112 113 114 115. so -5 + 1
;; so (- top-filled-line-index 4) is what should get multiplied by line len to get start of the start of TOP 100 lines
;; and if 0 is the bottom, then 1st line is 1 * 7
;;
;; now. hashtable returns second return value that signifies whether value was present in the hashtable
;;
(defun check-for-loop (top-filled-line-index lateral-moves
lateral-moves-initial-number current-shape grid states-hashmap)
(let* ((cur-moves (subseq lateral-moves 0 lateral-moves-initial-number))
(top-100-lines-lements-amount (* 7 100))
(start-index-of-top-100-lines (* 7 (- top-filled-line-index 99)))
(last-100-lines (make-array top-100-lines-lements-amount :displaced-to grid :displaced-index-offset start-index-of-top-100-lines))
(full-state (list current-shape cur-moves last-100-lines))
(hashmap-check (gethash full-state states-hashmap)))
(if (nth-value 1 hashmap-check)
;; state WAS previously saved
;; return the previous index where that was the case
(nth-value 0 hashmap-check)
;; first time seeing this state
(progn
(setf (gethash full-state states-hashmap) top-filled-line-index)
nil))))
;; now in our shitty throwing contest, let's call that function and whenever it finds a loop
;; print it out
(defparameter *found-loop-info* nil)
(defun try-dropping-search-loop (figures initial-lateral-moves
times grid)
;; (print-grid grid)
(format t "starting~%")
(let* ((top (1- (array-dimension grid 0))) ; max row with stone, get's smaller. 0 on the TOP
(percent-index (floor (/ times 100)))
(running-percent-index 0)
(additional-count 0)
(states-for-100-lines (make-hash-table :test #'equalp))
(endless-lateral-moves (circular initial-lateral-moves)))
;; outer loop is simple dotimes for amount of figures we want to drop
(dotimes (i times)
;; fuck i forgot about my inverted TOP. it goes to 0
(when (= percent-index running-percent-index)
(setq running-percent-index 0)
(format t "One more: ~a%, , intermediate height: ~a; the step is ~a; the times is ~a~%"
(floor (* 100 (/ i times))) (- (array-dimension grid 0) top 1) i times)
)
(incf running-percent-index)
(let* ((hook (cons (- top 4) 2))
(fig (pop figures))
(check-result (check-for-loop top endless-lateral-moves (length initial-lateral-moves)
fig grid states-for-100-lines)))
(when (check-result)
(setq *found-loop-info* `(found ,check-result start point at ,top check
with ,fig ))
(format t "found loop previously recorded at ~a
now it's ~a" check-result top)
)
;; (print-intermediate-step fig grid hook)
(loop
;; first check lateral move (just after apperaing)
;; (print-intermediate-step fig grid hook)
(let* ((lat-move (pop lateral-moves))
(lateral-change (check-move fig grid hook lat-move)))
(setq hook (cons (car hook) (+ lateral-change (cdr hook))))
;; (format t "Looping for ~a figure ~a~%hook:~a; move~a -> ~a~%"
;; i fig hook lat-move lateral-change)
)
;; (print-intermediate-step fig grid hook)
;; then check if possible to go down
(when (= 0 (check-move fig grid hook 'down))
;; all moves down done, update TOP and exit for next FIG
(setq top (min top (get-fig-top fig hook)))
(resting-into-array fig grid hook)
(return))
;; more moves down exist
;; do move down, and loop for the lateral change and possible exit
(setq hook (cons (1+ (car hook)) (cdr hook))))))
(+ additional-count (- (array-dimension grid 0) top 1)))
;; (print-grid grid)
)
(gc :full t)
(room t)
;; (/ (- sb-vm:dynamic-space-end sb-vm:dynamic-space-start) (expt 1024 2))
(init-test-grid 200000000)
;; 991133696 bytes available,
;; 5600000016 requested.
(sb-vm::dynamic-space-size)
;; 1073741824 (31 bits, #x40000000)
;; is that in bytes?
(sb-ext:dynamic-space-size)
;; 1073741824 (31 bits, #x40000000)
(/ 1073741824 1024 1024 1024 1024) ; 1/1024
;; so maybe in megabites
(/ 1073741824 1024 1024 1024) ; 1/1024
;; it seems that it's 1 Gb, not funny
;; (/ 981172224 1024 1024 1024 1024)
;; (* 10 1024 )
;; (* 1024 3)
;; ok, this is ridiculous
;; let's forget this
;;
;; i can't get more than 1 Gb
;; CL-USER> (sb-ext:dynamic-space-size)
;; 1073741824 (31 bits, #x40000000)
;; ok.
;;
;; Ugh. So. what? what do you do Sly. why not passing?
;;
;; so, with just inferior lisp it works. when i do it without "="
;;
;; ok. let's again, forget all that? ugh. so hard to just move on
;; yes, just move on. 1 Gb is what i get. can't figure out the configuration.
;; ugh
;;
;; UGH! I'm kind of hating it.
;; Interactively, both COMMAND and CODING-SYSTEM are nil and the
;; sly-restart-inferior-lisp didn't restart the underlying sbcl,
;; i suppose it should have asked.
;; oh, but I haven't even tried the M-x sly command
;;
;; so, maybe even just the
;; (setq inferior-lisp-program "sbcl --dynamic-space-size 10240")
;; could have been enough, if I actually killed the sbcl, not just restart
;;
;; well, this is strange
;; it does seem that it should "reastart" inferior lisp
;;
;; YUP, that's it. Thanks i hate it.
;; do i want to try to run this thing?
(defparameter *test-run-result* 0)
(setq *test-run-result* (try-dropping-search-loop *endless-shapes*
*input-lat-symbs* 10 *test-grid* )) ; this is not right. no lateral moves done
;; well, i think NOW i can let it go.
;; and return back LATER, to REWRITE THIS ANEW WITH MY UPDATED KNOWLEDGE.
;; SO HERE I GO, LEAVING THIS BEHIND

2893
day18-input.txt Normal file

File diff suppressed because it is too large Load Diff

166
day18-scratch.lisp Normal file
View File

@@ -0,0 +1,166 @@
;; ;; https://adventofcode.com/2022/day/18
;; so, 1x1x1 cubes on grid, given by x-y-z coords,
;; so each line is 1 cube.
;;
;; my guess is 1,1,1 is cube [0,1]x[0,1]x[0,1]
;; and 2,1,1 is cube [1,2]x[0,1]x[0,1]
;;
;; for cubes to have "joint" side - two dimentions should be totally same
;;
;; so, could do what? put into 3d array?
;; have 3 hash tables?
;;
;; allright, looking at discussions already.
;; i "could" consider these as graph nodes, but what would be the edges?
;;
;; the 3d array would be 'connectivity' matrix
;; then i'd want what ? go through all the nodes.
;; and for each node know how many neighbors it has.
;; that would directly transform into how many sides are open.
;; ok, i guess
(defparameter *day-18-test-input*
(mapcar
(lambda (line)
(mapcar #'parse-integer (cl-ppcre:split "," line)))
(uiop:read-file-lines "day18-test.txt")))
(setq *day-18-test-input* (coords-from-input "day18-test.txt"))
;; so. init array and fill with nodes
;; figure out maximal values?
(loop
for (x y z) in *day-18-test-input*
maximize x into xs
maximize y into ys
maximize z into zs
finally (return (list xs ys zs)))
;; => (3 3 6)
(defparameter *day-18-test-graph-connectivity*
(make-array '(4 4 7) :initial-element 0))
;; fill the array with nodes
(loop
for (x y z) in *day-18-test-input*
do (setf (aref *day-18-test-graph-connectivity* x y z) 1))
;; and now would have to do full scan? that's not very fun =/
;; well, it's not quite what a connectivity matrix is, isn't it?
;; connectivity has 1 in (i j) if from node i to node j there's edge
;; and it current case we have only 1 unit length connections.
;; here's that
(neighbors-for '(2 2 2) *day-18-test-graph-connectivity*)
(neighbors-for '(1 1 1) *day-18-test-graph-connectivity*)
(neighbors-for '(2 3 5) *day-18-test-graph-connectivity*)
;; and now to iterate over all of the array?
;; how'd i do safer aref?
;; well, i guess ok.
(apply #'aref *day-18-test-graph-connectivity* '(2 3 5))
;; this is first time i see something like this
;; how to use that correctly though?
;; so, last value must be a list, and all values are appended
;; so just numbers and nil in the end would work?
;; and more importatntly passing array as just self works.
;; and splitting points as two lists should work, right?
(apply #'aref *day-18-test-graph-connectivity* 2 3 '(5))
;; no, it doesn't, only one by one with last thing as list
;; now loop over all elements as ask amount of neighbors and sum 6-neighbors?
(loop for x from 0 to 3 sum
(loop for y from 0 to 3 sum
(loop for z from 0 to 6
when (= 1 (aref *day-18-test-graph-connectivity* x y z))
summing (- 6
(length (neighbors-for (list x y z)
*day-18-test-graph-connectivity*)))
;; into the-sum
;; collecting (list x y z)
;; into nodes
;; finally (return (list the-sum nodes))
)
))
;; => (42 ((0 0 0) (0 0 1) (0 0 2) (0 0 3) (0 0 4) (0 0 5) (0 0 6)))
(neighbors-for '(2 2 2) *day-18-test-graph-connectivity*)
;; well it's not quite so pliant to use multiple 'summing 'collecting 'max 'into
;; when working with nested loops then
;; for those cases DO macro? =C
(count-open-sides *day-18-test-graph-connectivity*)
;; now for my own input?
(defparameter *day-18-input-coords* nil)
(setq *day-18-input-coords*
(coords-from-input "day18-input.txt"))
(defparameter *day-18-input-connectivity*
(make-array (find-maxes *day-18-input-coords*) :initial-element 0))
(fill-connectivity-array *day-18-input-coords* *day-18-input-connectivity*)
(count-open-sides *day-18-input-connectivity*)
;; now. how could i only include surface area
;; did i need to model points as what?
;;
;; well, i could start with 0th layer. there's no stone there, only air
;; and start filling with 2
;; then count for all points as previously, but only neighbors which are 2
;; i guess
;; so. start at '(0 0 0)
;; then get neighbors, filter those that are 0
;; put into queue / list - actually dfs is good enough, so just recurse?
(point-at-is '(0 0 0) *day-18-test-graph-connectivity* 0)
(point-at-is '(0 0 0) *day-18-test-graph-connectivity* 2)
(fill-outside-with-2 '(0 0 0) *day-18-test-graph-connectivity*)
;; this seems to work.
;; now i want to cound only outside that contacts 2?
;; so, same cound but look for neighbors 2 and count them, not 6 - stone-neighbors
(count-open-sides-to-outside *day-18-test-graph-connectivity*)
;; well, now i need to add 1 to all sides
(setq *day-18-test-input*
(coords-from-input "day18-test.txt"))
(setq *day-18-test-graph-connectivity*
(make-array (find-maxes *day-18-test-input*) :initial-element 0))
(fill-connectivity-array *day-18-test-input* *day-18-test-graph-connectivity*)
(fill-outside-with-2 '(0 0 0) *day-18-test-graph-connectivity*)
(count-open-sides-to-outside *day-18-test-graph-connectivity*)
;; and now it's 58
;; so, let's cound for full input?
;;; part 2
(setq *day-18-input-coords*
(coords-from-input "day18-input.txt"))
(setq *day-18-input-connectivity*
(make-array (find-maxes *day-18-input-coords*) :initial-element 0))
(fill-connectivity-array *day-18-input-coords* *day-18-input-connectivity*)
(fill-outside-with-2 '(0 0 0) *day-18-input-connectivity*)
(count-open-sides-to-outside *day-18-input-connectivity*)
;; 2484 - not correct, too low
;; there's 1 at the edge of the array. whoops. so there are 0s in the input?
;; yep. so now what, shift all by 1? and add one more +1 to the find max?
;; hahaha, this is stupid.
;; but let's do it
(coords-from-input "day18-test.txt") ; yep. +1
;; 2490

13
day18-test.txt Normal file
View File

@@ -0,0 +1,13 @@
2,2,2
1,2,2
3,2,2
2,1,2
2,3,2
2,2,1
2,2,3
2,2,4
2,2,6
1,2,5
3,2,5
2,1,5
2,3,5

71
day18.lisp Normal file
View File

@@ -0,0 +1,71 @@
;; https://adventofcode.com/2022/day/18
(ql:quickload 'cl-ppcre)
(defun coords-from-input (file-name)
(mapcar
(lambda (line)
(mapcar #'parse-integer (cl-ppcre:split "," line)))
(uiop:read-file-lines file-name)))
(defun find-maxes (all-coords)
(loop
for (x y z) in all-coords
maximize (+ x 3) into xs
maximize (+ y 3) into ys
maximize (+ z 3) into zs
finally (return (list xs ys zs))) )
(defun fill-connectivity-array (all-coords connectivity-matrix)
(loop
for (x y z) in all-coords
do (setf (aref connectivity-matrix x y z) 1)))
;; 1 - rock, 0 - initial empty, 2 - outside air
(defun neighbors-for (coords connectivity-matrix &key (type 1))
(labels ((coords-fit (potential-point)
(loop for i from 0 to 2
always (and (< (nth i potential-point)
(array-dimension connectivity-matrix i))
(>= (nth i potential-point) 0)))))
(loop
for deltas in `((1 0 0) (-1 0 0)
(0 1 0) (0 -1 0)
(0 0 1) (0 0 -1))
for neighbor = (mapcar #'+ coords deltas)
when
(and (coords-fit neighbor)
(= type (apply #'aref connectivity-matrix neighbor)))
collect neighbor)))
(defun count-open-sides (connectivity-matrix)
(destructuring-bind (n m k)
(array-dimensions connectivity-matrix)
(loop for x from 0 below n sum
(loop for y from 0 below m sum
(loop for z from 0 below k
when (= 1 (aref connectivity-matrix x y z))
summing (- 6
(length (neighbors-for (list x y z) connectivity-matrix))))))))
(defun point-at-is (coords connectivity-matrix elem)
(= elem (apply #'aref connectivity-matrix coords)))
;; call with initial coord '(0 0 0)
(defun fill-outside-with-2 (coord connectivity-matrix)
(when (point-at-is coord connectivity-matrix 0)
(setf (apply #'aref connectivity-matrix coord) 2)
(mapcar (lambda (neighbor) (fill-outside-with-2 neighbor connectivity-matrix))
(neighbors-for coord connectivity-matrix :type 0))))
(defun count-open-sides-to-outside (connectivity-matrix)
(destructuring-bind (n m k)
(array-dimensions connectivity-matrix)
(loop for x from 0 below n sum
(loop for y from 0 below m sum
(loop for z from 0 below k
when (= 1 (aref connectivity-matrix x y z))
summing (length (neighbors-for
(list x y z)
connectivity-matrix
:type 2)))))))

3
day19-2-input.txt Normal file
View File

@@ -0,0 +1,3 @@
Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 12 clay. Each geode robot costs 4 ore and 19 obsidian.
Blueprint 2: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 11 clay. Each geode robot costs 4 ore and 12 obsidian.
Blueprint 3: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 18 clay. Each geode robot costs 2 ore and 11 obsidian.

30
day19-input.txt Normal file
View File

@@ -0,0 +1,30 @@
Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 12 clay. Each geode robot costs 4 ore and 19 obsidian.
Blueprint 2: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 11 clay. Each geode robot costs 4 ore and 12 obsidian.
Blueprint 3: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 18 clay. Each geode robot costs 2 ore and 11 obsidian.
Blueprint 4: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 15 clay. Each geode robot costs 4 ore and 20 obsidian.
Blueprint 5: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 16 clay. Each geode robot costs 4 ore and 17 obsidian.
Blueprint 6: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 19 clay. Each geode robot costs 2 ore and 12 obsidian.
Blueprint 7: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 9 clay. Each geode robot costs 2 ore and 10 obsidian.
Blueprint 8: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 5 clay. Each geode robot costs 3 ore and 7 obsidian.
Blueprint 9: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 11 clay. Each geode robot costs 4 ore and 8 obsidian.
Blueprint 10: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 16 clay. Each geode robot costs 2 ore and 15 obsidian.
Blueprint 11: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 20 clay. Each geode robot costs 2 ore and 19 obsidian.
Blueprint 12: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 16 clay. Each geode robot costs 3 ore and 20 obsidian.
Blueprint 13: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 20 clay. Each geode robot costs 3 ore and 14 obsidian.
Blueprint 14: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 20 clay. Each geode robot costs 2 ore and 15 obsidian.
Blueprint 15: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 15 clay. Each geode robot costs 3 ore and 12 obsidian.
Blueprint 16: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 17 clay. Each geode robot costs 3 ore and 19 obsidian.
Blueprint 17: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 14 clay. Each geode robot costs 4 ore and 9 obsidian.
Blueprint 18: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 6 clay. Each geode robot costs 3 ore and 16 obsidian.
Blueprint 19: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 6 clay. Each geode robot costs 2 ore and 14 obsidian.
Blueprint 20: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 11 clay. Each geode robot costs 3 ore and 15 obsidian.
Blueprint 21: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 18 clay. Each geode robot costs 4 ore and 19 obsidian.
Blueprint 22: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 15 clay. Each geode robot costs 2 ore and 20 obsidian.
Blueprint 23: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 5 clay. Each geode robot costs 2 ore and 10 obsidian.
Blueprint 24: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 10 clay. Each geode robot costs 2 ore and 14 obsidian.
Blueprint 25: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 7 clay. Each geode robot costs 4 ore and 13 obsidian.
Blueprint 26: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 20 clay. Each geode robot costs 2 ore and 20 obsidian.
Blueprint 27: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 18 clay. Each geode robot costs 2 ore and 19 obsidian.
Blueprint 28: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 10 clay. Each geode robot costs 2 ore and 7 obsidian.
Blueprint 29: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 15 clay. Each geode robot costs 3 ore and 7 obsidian.
Blueprint 30: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 20 clay. Each geode robot costs 4 ore and 18 obsidian.

462
day19-scratch.lisp Normal file
View File

@@ -0,0 +1,462 @@
;; https://adventofcode.com/2022/day/19
;; whelp. do i do somehow DP? generic over parameters of blueprints somehow
;; we could potentially calculate optimal step in forward time, but i'm not sure how.
;; and backward time - no easy way to know which robots will be available?
;;
;; intuitive idea, have some state of (resource1, recource2, robot1, robot2)
;; and have 2 types of steps, one - production is simple
;; then we can have different types of actions - build robot1 \ build robot2 - parallel these out
;; somehow prune ideally, but then move forward in time and get max of these. i guess it's ok plan
;; so.
;; - each robot collects 1 of it's own resource per minute
;; so function to update state with new resources is common
;; - cost of one new robot, consumed immediately, robot is produced in 1 minute
;; costs are different and listed in the bluerint
;; i suppose overall format of the blueprint is the same, only numbers change.
;; so could hardcode the translation
;;
;; and i guess i'd have one class of "blueprint" and several instances,
;; each instance does the updating of the state.
(in-package :day-19)
(defclass state ()
((geodes :initform 0 :initarg :geodes)
(ore :initform 0 :initarg :ore)
(clay :initform 0 :initarg :clay)
(obsidian :initform 0 :initarg :obsidian)
(geodes-robot :initform 0 :initarg :geodes-robot)
(ore-robot :initform 1 :initarg :ore-robot)
(clay-robot :initform 0 :initarg :clay-robot)
(obsidian-robot :initform 1 :initarg :obsidian-robot)))
(defclass blueprint ()
((ore-robot-cost :initarg :ore)
(clay-robot-cost :initarg :clay)
(obsidian-robot-cost :initarg :obsidian)
(geode-robot-cost :initarg :geode)))
;; wrote like this initially
(make-instance 'state)
;; i'd like to have code across building robots, checking whether robot can be build
;; to be shared. would i want to do it with classes?
;; state could have hashmaps from symbol to the amount
;; do i want to have plists?
(defparameter *my-plist* '(:ore 1 :clay 15))
*my-plist*
(getf *my-plist* :ore)
(getf *my-plist* :clay)
(setf (getf *my-plist* :clay) 3)
;; i guess i like that
;; then i could have robot costs as plists as well?
;; i could iterate over the plist with destructuring
;; and blueprint can just be plist of plists
;; we don't really need generic method dispatch
;; but for state - i'd kind of want to have static field
;; to share found max and pruning
(loop
for (resource cost) on '(:ore 3 :clay 14) by #'cddr
;; for (resource cost) in (getf *test-blueprint* :obsidian)
collect (list (* 2 cost) 'is 'cost resource) )
;; yes. comprehension is possible
(defparameter *test-state* (make-instance 'state))
(setf (getf (resources *test-state*) :ore 0) 5)
(setf (getf (robots *test-state*) :ore 0) 2)
(setf (getf (robots *test-state*) :obsidian 0) 5)
;; now let's check my function for can-create
(print *test-state*)
(can-create-robot *test-blueprint* :ore *test-state*)
(can-create-robot *test-blueprint* :clay *test-state*)
(can-create-robot *test-blueprint* :geode *test-state*)
(can-create-robot *test-blueprint* :obsidian *test-state*)
;; yay, i guess
;;
;; i had the error of putting quoted lists into the quoted list
;;
;; and now function to create new state with resources for a particular robot deducted?
;; and i guess with that robot already increased.
;; that function would signify passing of one turn \ minute
(setq *test-state* (make-instance 'state))
(setf (getf (resources *test-state*) :ore 0) 3)
(defparameter *another-state*
(create-robot *test-blueprint* :clay *test-state*))
;; well, that seems to work.
;; now i'd need to create blueprints from the lines.
;; then for each of the blueprint, calculate maximum of geodes.
;; multiply with the :id and sum.
;;
;; ok, i guess. i'd want a function that takes in blueprint.
;; gets initial state. and recurses searching for maximum
;; maybe even saving into blueprint as well.
;; how would that recursion look?
;; ore is added at the end of the minute.
;; resources for building is taken out at the beginning of the minute
;; built bot is added at the end of the minute
;;
;; so, i could
;; - calculate resources to be added
;; - for each possible (on old resources) bot build
;; recurse with bot cost deducted and new resources added
;; so next functions would be
;; - resources-to-be-collected :: just the plist of additional resources that would be
;; generated in 1 turn
;; and
;; - add-resources :: modifying operation that would update state
*test-state*
(calc-resources-to-be-collected *test-state*)
;; lol.
(add-resources '(:spagetty 1 :tuna 2) *test-state*)
;; and it works
;; so, now only main loop i suppose. and maybe-maybe later-later pruning
(get-possible-bot-builds *test-blueprint* *test-state*)
(defmethod find-max-geod (blueprints (s state) minute)
;; (format t "in step for ~a; with ~a~%" minute s)
(if (= 25 minute)
(getf (resources s) :geode 0)
(progn
(let* ((will-collect-this-minute (calc-resources-to-be-collected s))
(max-if-building
(loop
for bot-type in (get-possible-bot-builds blueprints s)
for state-with-new-bot = (create-robot blueprints bot-type s)
when state-with-new-bot
maximize (progn
(add-resources will-collect-this-minute state-with-new-bot)
(find-max-geod blueprints state-with-new-bot (1+ minute)))))
(if-not-building (let ((state-copy (copy-state s)))
;; (break)
(add-resources will-collect-this-minute state-copy)
(find-max-geod blueprints state-copy (1+ minute)))))
(max (or max-if-building 0) if-not-building)))))
;; Blueprint 1:
;; Each ore robot costs 4 ore.
;; Each clay robot costs 2 ore.
;; Each obsidian robot costs 3 ore and 14 clay.
;; Each geode robot costs 2 ore and 7 obsidian.
;; Blueprint 2:
;; Each ore robot costs 2 ore.
;; Each clay robot costs 3 ore.
;; Each obsidian robot costs 3 ore and 8 clay.
;; Each geode robot costs 3 ore and 12 obsidian.
;; do i just test this?
(setq *test-blueprint* '(:ore (:ore 4)
:clay (:ore 2)
:obsidian (:ore 3 :clay 14)
:geode (:ore 2 :obsidian 7)))
(setq *test-state* (make-instance 'state))
;; (print (find-max-geod *test-blueprint* *test-state* 1))
;; => 0
;; that's because i have no ability to "wait"
;; whoops
;; so. do i want, um. add one more attempted call after the loop in the iteration?
;; now. the looping is serious.
;; would it work for me to order keys geode first
;; now we seem to get geodes first, yay
;; maybe just run without printing?
;; let's check manually that when i do state copy, the plists are independent?
(setq *test-state* (make-instance 'state))
*test-state*
(setq *another-state* (copy-state *test-state*))
(incf (getf (resources *another-state*) :ore 0))
*another-state*
(add-resources '(:seeds 151) *another-state*)
(incf (getf (robots *another-state*) :obsidian 0))
;; oh, i didn't check that state returned from the "create bot" is independent
(setq *test-state* (make-instance 'state))
(add-resources '(:ore 10) *test-state*)
(setq *another-state* (create-robot *test-blueprint* :clay *test-state*))
;; ugh. resources stays shared.
;; WTF, why
;; manually create new list, i guess then then do set to the 'copied state'?
;; this is unpleasant
;; so, i guess use (copy-list
;; ok. the numbers seem ok. but this is long.
;; how do i trim this?
;; if on step 10 there's already a state with 3 obsidian machines.
;; does this state would always be ahead of
;; state on step 10 with 1 obsidian machine?
;;
;; it seems so!
;; for which reason? because if the state got 3 geode machines, it will be able to get more?
;; i suppose only when i reach case where each new step can add one more geod machine
;; only then i can guess the state is actually domeeneering?
;; but only over states with same amount of steps?
;; ok. let's commit what i have right now and try to trim?
;; how could i compare with that "cur-max" and update that cur-max?
;; no, i don't understand
(format t "some result ~a~%" (find-max-geod *test-blueprint* *test-state* 1))
;; well, yes one optimizaiton - stop building robots, when resource is to the top of
;; max daily expense
;; that would reduce a lot
;; 1)
;; would be nice to put these into (possible-robots-to-build)
;; so that it would also filtered out unnecessary new robots
;;
;; 2)
;; "keep global current max state" how would i compare and check if it's impossible to beat?
;; with "even if i could to build geod machine every day for rest N days"
*test-blueprint*
*test-state*
(add-resources '(:ore 10) *test-state*)
(incf (getf (robots *test-state*) :ore) 2)
(any-use-of-creating-robot *test-blueprint* *test-state* :ore)
(any-use-of-creating-robot *test-blueprint* *test-state* :clay)
(any-use-of-creating-robot *test-blueprint* *test-state* :obsidian)
(any-use-of-creating-robot *test-blueprint* *test-state* :geode)
(max-need *test-blueprint* *test-state* :ore)
(max-need *test-blueprint* *test-state* :clay)
(max-need *test-blueprint* *test-state* :obsidian)
(max-need *test-blueprint* *test-state* :geode)
;; and this is not good for :geode, we want as much as possible
(get-possible-bot-builds *test-blueprint* *test-state*)
;; and now let's add static "max state"?
;; i'd need comparison like "can catch up" with that found max "is dominated by"
;; and also way to update that maximal state?
;;
;; so, what will that be?
;; comparison for update, should it also be if i found a state that dominates?
;; only for satiated states?
;;
;; if day is same or more
;; but the amount of geode robots and geodes is smaller?
(is-satiated-p *test-blueprint* *test-state*)
(incf (getf (robots *test-state*) :obsidian 0) 20)
;; seems to work,
;; but i already want to utilize some test framework
;; whelp. i do want to test this
;; 4 14 7 to be satisfied
(is-satiated-p
*test-blueprint*
(make-instance 'state :robots '(:ore 4 :clay 14 :obsidian 7 :geode 2)))
(is-satiated-p
*test-blueprint*
(make-instance 'state :resources '(:ore 4 :clay 14 :obsidian 7 :geode 2))) ; not, need robots
(is-satiated-p
*test-blueprint*
(make-instance 'state :robots '(:ore 4 :clay 14 :obsidian 7 :geode 2)))
;; now for checking is-dominated. ugh.
(a-dominates-b-p
*test-blueprint*
(make-instance 'state :robots '(:ore 4 :clay 14 :obsidian 7 :geode 2))
(make-instance 'state :robots '(:ore 4 :clay 14 :obsidian 7 :geode 2)))
;; both satiated, but second bigger
(a-dominates-b-p
*test-blueprint*
(make-instance 'state :robots '(:ore 5 :clay 17 :obsidian 7 :geode 2))
(make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2)))
;;
;; both satiated, but second not always bigger
(a-dominates-b-p
*test-blueprint*
(make-instance 'state :robots '(:ore 5 :clay 17 :obsidian 9 :geode 2))
(make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 8 :geode 2)))
;;
;; first not satiated, even though second is bigger - nil
(a-dominates-b-p
*test-blueprint*
(make-instance 'state :robots '(:ore 2 :clay 17 :obsidian 9 :geode 2))
(make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 8 :geode 2)))
;; and that's not right. if we have on same amount of steps
;; reference as satiated and checking as not - wouldn't keep up
;; so big check should be whether steps are even in imagination permit
;; ugh. that would mean putting minute\step into state.
;; um, let's not do it right now?
;; for both satiated is a very weak check, but let's try it like this?
(setq *test-state* (make-instance 'state))
(setf (cur-found-max *test-state*) (make-instance 'state))
;; so whelp
;; should have committed after doing the "build makes sence list"
;;
;; my problems are because "is dominated by" is not simmetrical to "dominates"
;; and i want both
;;
;; now in the loop set first satiated as domination
;; after that compare if our set dominates that one and swap
;; and compare if it's dominated by that one and prune
;; so, only if ref earlier than checked state.
;; and then - if checked not saitated, or by all resources less than
;; but i do want tests
;; both satiated, but second bigger
(a-dominates-b-p
*test-blueprint*
(make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2) :minute 2)
(make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2) :minute 3))
;; should be NIL
;; now want to check for different amount of steps.
;; so if same resources but first is earlier - it dominates
(minute (make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2) :minute 2))
;; i was putting :minute 2 into :robots plist, cool, no thanks to you types
(minute (make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2) :minute 2))
;; ok. this also seems well.
;; then main loop? on fisrt satiated set as `cur-found-max`
;; and after that always check -
(defmethod find-max-geod-2 (blueprints (s state))
;; (declare (optimize (debug 3)))
;; (format t "in step for ~a; with ~a~%" (minute s) s)
(cond
((= 25 (minute s)) ; exit condition fully calculated
(getf (resources s) :geode 0))
((< (estimate s) (cur-found-max s))
;; (print "pruning")
0) ; pruning this branch
(t ; default check
(progn
(let* ((will-collect-this-minute (calc-resources-to-be-collected s))
(possible-bot-builds (get-possible-bot-builds blueprints s))
(max-if-building
(when possible-bot-builds
(loop
for bot-type in possible-bot-builds
for state-with-new-bot = (create-robot blueprints bot-type s)
when state-with-new-bot
maximize (progn
(add-resources will-collect-this-minute state-with-new-bot)
(incf (minute state-with-new-bot))
(find-max-geod-2 blueprints state-with-new-bot )))))
(if-not-building
(let ((state-copy (copy-state s)))
;; (break)
(add-resources will-collect-this-minute state-copy)
(incf (minute state-copy))
(find-max-geod-2 blueprints state-copy )))
(recursed-max (max (or max-if-building 0) if-not-building)))
;; (break)
;; (format t "would build ~a~%" possible-bot-builds)
(when (> recursed-max (cur-found-max s))
(setf (cur-found-max s) recursed-max))
recursed-max
)))))
(setq *test-state* (make-instance 'state))
(setf (cur-found-max *test-state*) 0)
(timing (print (find-max-geod-2 *test-blueprint* *test-state*)))
(timing (let ((a 1) (b 2)) (* a b 15)))
;; thank you CL-Cookbook: https://cl-cookbook.sourceforge.net/dates_and_times.html
(defmacro timing (&body forms)
(let ((real1 (gensym))
(real2 (gensym))
(run1 (gensym))
(run2 (gensym))
(result (gensym)))
`(let* ((,real1 (get-internal-real-time))
(,run1 (get-internal-run-time))
(,result (progn ,@forms))
(,run2 (get-internal-run-time))
(,real2 (get-internal-real-time)))
(format *debug-io* ";;; Computation took:~%")
(format *debug-io* ";;; ~f seconds of real time~%"
(/ (- ,real2 ,real1) internal-time-units-per-second))
(format t ";;; ~f seconds of run time~%"
(/ (- ,run2 ,run1) internal-time-units-per-second))
,result)))
;; so, why doesn't it ever builds obsidian?
*test-blueprint*
;; because is "has to build something if it can" whops
;; wow 20 seconds. cool
;; last things:
;; read in the line for the blueprints into plist
;; then loop over lines in file
;; for each line compute max, multiply by index
;; and sum
;; ok, i guess
(rest (remove-if-not #'identity
(mapcar (lambda (str) (parse-integer str :junk-allowed t))
(ppcre:split " "
"Blueprint 2: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 8 clay. Each geode robot costs 3 ore and 12 obsidian."))))
(blueprint-line-to-plist "Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 2 ore. Each obsidian robot costs 3 ore and 14 clay. Each geode robot costs 2 ore and 7 obsidian.")
;; and now loop over file.
(print (with-open-file (in "day19-test.txt")
(loop
for line = (read-line in nil nil)
for n from 1
for blueprints = (when line (progn
(format t "Starting processing for ~a~%" line)
(blueprint-line-to-plist line)))
for max-geo = 0
;; for max-geo = (when blueprints
;; (progn
;; (setf (cur-found-max *test-state*) 0)
;; (timing (find-max-geod-2 blueprints (make-instance 'state)))))
while blueprints
do (format t "processed ~a : ~a. its max is ~a~%" n blueprints max-geo)
summing (* n max-geo))))
(format t "and the result is : ~a~%" (read-and-calc-part-1 "day19-test.txt"))
(format t "and the result is : ~a~%" (read-and-calc-part-1 "day19-input.txt"))
;; wtf is taking so long in between the processings?
(apply #'* (list 2 3 5))
;; but before that - change exit point
(format t "and the result is : ~a~%" (read-and-calc-part-2 "day19-2-input.txt"))
;; 261 is too low. so
;; but in previous my maxes were 0 1 2
;; and current are 3 3 29
;; but still not good
;; ugh. what about test input?
(format t "and the result is : ~a~%" (read-and-calc-part-2 "day19-test.txt"))
;; my calc : 18 and 55
;; correct : 56 and 62
;; coooool. let's move on.

2
day19-test.txt Normal file
View File

@@ -0,0 +1,2 @@
Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 2 ore. Each obsidian robot costs 3 ore and 14 clay. Each geode robot costs 2 ore and 7 obsidian.
Blueprint 2: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 8 clay. Each geode robot costs 3 ore and 12 obsidian.

193
day19.lisp Normal file
View File

@@ -0,0 +1,193 @@
;; https://adventofcode.com/2022/day/19
(defpackage :day-19
(:use :cl))
(in-package :day-19)
(ql:quickload 'cl-ppcre)
(defparameter *all-types* '(:geode :obsidian :clay :ore))
(defclass state ()
((resources :accessor resources :initform nil :initarg :resources)
(robots :accessor robots :initform (list :ore 1) :initarg :robots)
(minute :accessor minute :initarg :minute :initform 1 )
(cur-found-max :initform nil :accessor cur-found-max :allocation :class) ; would be nice to add types
))
(defmethod print-object ((obj state) stream)
(print-unreadable-object (obj stream :type t)
(with-slots (resources robots)
obj
(format stream "collected: ~a, with robots: ~a"
resources robots))))
;; example of blueprint:
(defparameter *test-blueprint*
'(:ore (:ore 4)
:clay (:ore 2)
:obsidian (:ore 3 :clay 14)
:geode (:ore 2 :obsidian 7)))
;; thank you blambert & stackoverflow
;; https://stackoverflow.com/questions/11067899/is-there-a-generic-method-for-cloning-clos-objects
;; oh, but this is shallow copy and lists reused. crap
(defmethod copy-state ((s state))
(make-instance 'state :resources (copy-list (resources s))
:robots (copy-list (robots s))
:minute (minute s)))
(defmethod can-create-robot (blueprints type (s state))
(let ((this-robot-costs (getf blueprints type)))
(loop for (resource amount) on this-robot-costs by #'cddr
always (>= (getf (resources s) resource 0) amount))))
(defmethod create-robot (blueprints type (s state))
(when (can-create-robot blueprints type s)
(let ((this-robot-costs (getf blueprints type))
(copied-state (copy-state s)))
(loop for (resource amount) on this-robot-costs by #'cddr
do (incf (getf (resources copied-state) resource 0) (- amount)))
(incf (getf (robots copied-state) type 0))
copied-state)))
(defmethod calc-resources-to-be-collected ((s state))
(robots s))
(defmethod add-resources (new-resources (s state))
(loop for (resource amount) on new-resources by #'cddr
do (incf (getf (resources s) resource 0) amount)))
;; robot is unnecessary if resouce it brings is alreay produced
;; at amount of maximal possible per-turn expence
(defmethod max-need (blueprints (s state) resource-type)
(loop
for (la blueprint) on blueprints by #'cddr
;; do (print blueprint)
maximize (getf blueprint resource-type 0)))
(defmethod any-use-of-creating-robot (blueprints (s state) robot-type)
(if (eq :geode robot-type)
t ; always reason to build more geode robots
(let ((max-need (max-need blueprints s robot-type))
(state-production (getf (robots s) robot-type 0)))
;; (format t "comparing need ~a with prod ~a" max-need state-production)
(> max-need state-production))))
(defmethod get-possible-bot-builds (blueprints (s state))
(remove-if-not (lambda (robot-type)
(any-use-of-creating-robot blueprints s robot-type))
(remove-if-not (lambda (robot-type)
(can-create-robot blueprints robot-type s))
*all-types*)))
;; true when no longer need to build secondary robots
(defmethod is-satiated-p (blueprints (s state))
(loop for type in '(:ore :clay :obsidian)
never (any-use-of-creating-robot blueprints s type)))
(defmethod a-dominates-b-p (blueprints (a state) (b state))
;; (declare (optimize (debug 3)))
(when (is-satiated-p blueprints a) ; when not a satiated - don't know
(and
(<= (minute a) (minute b)) ; a earlier than b
(or
(not (is-satiated-p blueprints b))
(loop for resource-type in *all-types* ; for both satiated compare all resources
always (and (>= (getf (resources a) resource-type 0)
(getf (resources b) resource-type 0))
(>= (getf (robots a) resource-type 0)
(getf (robots b) resource-type 0))))))))
;; loose bound on geodes
(defmethod estimate ((s state))
(let ((time-left (- 25 (minute s))))
(+ (getf (resources s) :geode 0)
(* time-left (getf (robots s) :geode 0))
(/ (* time-left (1- time-left)) 2))))
(defmethod find-max-geod-2 (blueprints (s state))
(declare (optimize (speed 3)))
;; (declare (optimize (debug 3)))
;; (format t "in step for ~a; with ~a~%" (minute s) s)
(cond
(
(= 33 (minute s)) ; exit condition fully calculated
;; (= 25 (minute s)) ; exit condition fully calculated
(getf (resources s) :geode 0))
((< (estimate s) (cur-found-max s))
;; (print "pruning")
0) ; pruning this branch
(t ; default check
(progn
(let* ((will-collect-this-minute (calc-resources-to-be-collected s))
(possible-bot-builds (get-possible-bot-builds blueprints s))
(max-if-building
(when possible-bot-builds
(loop
for bot-type in possible-bot-builds
for state-with-new-bot = (create-robot blueprints bot-type s)
when state-with-new-bot
maximize (progn
(add-resources will-collect-this-minute state-with-new-bot)
(incf (minute state-with-new-bot))
(find-max-geod-2 blueprints state-with-new-bot )))))
(if-not-building
(let ((state-copy (copy-state s)))
;; (break)
(add-resources will-collect-this-minute state-copy)
(incf (minute state-copy))
(find-max-geod-2 blueprints state-copy )))
(recursed-max (max (or max-if-building 0) if-not-building)))
;; (break)
;; (format t "would build ~a~%" possible-bot-builds)
(when (> recursed-max (cur-found-max s))
(setf (cur-found-max s) recursed-max))
recursed-max
)))))
(defun blueprint-line-to-plist (line)
(destructuring-bind
(ore-cost-in-ore clay-cost-in-ore obs-cost-in-ore obs-cost-in-clay
geod-cost-in-ore geod-cost-in-obs)
(rest (remove-if-not #'identity
(mapcar (lambda (str) (parse-integer str :junk-allowed t))
(ppcre:split " " line))))
`(:ore (:ore ,ore-cost-in-ore)
:clay (:ore ,clay-cost-in-ore)
:obsidian (:ore ,obs-cost-in-ore :clay ,obs-cost-in-clay)
:geode (:ore ,geod-cost-in-ore :obsidian ,geod-cost-in-obs))))
(defun read-and-calc-part-1 (filename)
(with-open-file (in filename)
(loop
for line = (read-line in nil nil)
for n from 1
for blueprints = (when line (blueprint-line-to-plist line))
for max-geo = (when blueprints
(progn
(setf (cur-found-max *test-state*)
0)
(format t "Starting processing for ~a" line)
(timing (find-max-geod-2 blueprints (make-instance 'state)))))
while blueprints
do (format t "processed ~a. its max is ~a~%" n max-geo)
summing (* n max-geo))))
(defun read-and-calc-part-2 (filename)
(with-open-file (in filename)
(loop
for line = (read-line in nil nil)
for n from 1
for blueprints = (when line (progn
(format t "Starting processing for ~a~%" line)
(blueprint-line-to-plist line)))
for max-geo = (when blueprints
(progn
(setf (cur-found-max *test-state*) 0)
(timing (find-max-geod-2 blueprints (make-instance 'state)))))
while blueprints
do (format t "processed ~a. its max is ~a~%" n max-geo)
collecting max-geo into maxes
finally (return (apply #'* maxes)))))

5000
day20-input.txt Normal file

File diff suppressed because it is too large Load Diff

264
day20-scratch.lisp Normal file
View File

@@ -0,0 +1,264 @@
;; https://adventofcode.com/2022/day/20
(in-package :day-20)
;; so. how would i do moves in a list?
;; and are there duplicate numbers?
;; it's possible but not sure.
;; also in the input numbers are 4k 5k.
;; i guess on during the moving it would be best to figure out their index?
;; could i insert into list at index?
;; it could be nice to use just cycled list. but.
;; maybe use array?
'(1 2 -3 3 -2 0 4)
;; calculating index and then modifying array. is it easy to do shifts on array?
;; and i'd sometimes need to
;; and how multiple passes work with going over self?
;; let's take a break
;; i guess i could copy part of array with the offset arrays
;;
;; the stupid version seems to be 4 cases :
;; - to right inside of array
;; - to right over with overflow
;; - to left inside of array
;; - to left over with overflow
;; but when overflow - could stop to the left or to the right of self.
(defparameter *my-arr*
(aops:linspace 0 9 10))
;; imagine i'm displacing 345 by 1 to right
;; ( that would mean 6 moving 3 to the left)
(setq *my-arr* (aops:linspace 0 9 10))
(let ((to-be-moved (make-array 3 :displaced-to *my-arr* :displaced-index-offset 3))
(into-these-move (make-array 3 :displaced-to *my-arr* :displaced-index-offset 4)))
(loop
for i from 2 downto 0
do (setf (aref into-these-move i) (aref to-be-moved i))))
*my-arr*
;; now displacing 345 by 1 to left
(setq *my-arr* (aops:linspace 0 9 10))
(let ((to-be-moved (make-array 3 :displaced-to *my-arr* :displaced-index-offset 3))
(into-these-move (make-array 3 :displaced-to *my-arr* :displaced-index-offset 2)))
(loop
for i from 0 below 3
do (setf (aref into-these-move i) (aref to-be-moved i))))
*my-arr*
;; now let's also remember "moved" element and put it to the "freed up space"
;; moving 6 by 3 to the left
(setq *my-arr* (aops:linspace 0 9 10))
(let* ((index-of-moved 6)
(moved-value (aref *my-arr* index-of-moved))
(move-by -3)
(to-be-moved (make-array 3 :displaced-to *my-arr*
:displaced-index-offset (+ index-of-moved move-by)))
(into-these-move (make-array 3 :displaced-to *my-arr*
:displaced-index-offset (+ index-of-moved move-by 1))))
(loop
for i from 2 downto 0
do (setf (aref into-these-move i) (aref to-be-moved i)))
(setf (aref *my-arr* (+ index-of-moved move-by)) moved-value))
*my-arr*
;; ok. but these 2 downto 0 || 0 to 2 dependent on -3 +3 and that's ugh
;; moving 2 by 3 to the right (now displacing 345 by 1 to left)
(setq *my-arr* (aops:linspace 0 9 10))
(let* ((index-of-moved 2)
(moved-value (aref *my-arr* index-of-moved))
(move-by 3)
(to-be-moved (make-array 3 :displaced-to *my-arr*
:displaced-index-offset (+ index-of-moved 1)))
(into-these-move (make-array 3 :displaced-to *my-arr*
:displaced-index-offset index-of-moved)))
(loop
for i from 0 to 2
do (setf (aref into-these-move i) (aref to-be-moved i)))
(setf (aref *my-arr* (+ index-of-moved move-by)) moved-value))
*my-arr*
;; so also difference in displaced indexes.
;; shift to LEFT (move item left):
;;
;; shift to RIGHT (move item right):
;; well, i could just save this code as two separate functions
;; would be nice to immediately start doing the repeatable tests
(move-item-to-left (aops:linspace 0 9 10) 6 6)
;; and a separate function for swithing to the right?
(move-item-to-right (aops:linspace 0 9 10) 6 1)
(move-item-to-right (aops:linspace 0 9 10) 6 2)
(move-item-to-right (aops:linspace 0 9 10) 6 3)
;; next what? calculation of the target index through modulo
'(1 2 3 4 5 6 7 8 9)
;; if we're moving 2 by -2 how does that work?
;; we have starting index 1, we have length 9.
;; my guess is that take MOD by 9-1
;; how many swaps to the right until the element returns to its original place?
'(1 2 3 4 5 6 7 8 9)
'(2 1 3 4 5 6 7 8 9)
'(1 3 4 5 6 7 8 9 2)
'(1 3 4 5 6 7 8 2 9)
'(1 3 4 5 6 7 2 8 9)
'(1 3 4 5 6 2 7 8 9)
'(1 3 4 5 2 6 7 8 9)
'(1 3 4 2 5 6 7 8 9)
'(1 3 2 4 5 6 7 8 9)
'(1 2 3 4 5 6 7 8 9)
;; so, if moving by 9. hm
;; then moving by 12 is 9 + 3
(mod 9 3)
(mod 10 3)
(length (make-array 7))
(move-item-to-left (aops:linspace 0 9 10) 6 9)
;; ok, now join into one function that moves the element by it's value?
(find 4 '(1 4 3 2 9))
(position 4 '(1 4 3 2 9))
(defparameter *test-array* (make-array 7 :initial-contents '(1 2 -3 3 -2 0 4)))
*test-array*
(move-elem-by-itself *test-array* -2)
;; whelp. my movements are ugh.
;; so. "i'd want additional move on top of my move-left and move-right"?
(mod -1 3)
(move-item *test-array* 3 3)
(move-item *test-array* 3 4)
(defparameter *test-array* (make-array 7 :initial-contents '(1 2 -3 3 -2 0 4)))
*test-array*
(move-elem-by-itself *test-array* -2)
;; this seems to work.
;; now back to the loop?
(defparameter *test-array* (make-array 7 :initial-contents '(1 2 -3 3 -2 0 4)))
(mixing-array *test-array*)
;; after moving 2, arr: #(1 -3 2 3 -2 0 4)
;; after moving -3, arr: #(1 2 3 -2 0 -3 4)
;; -3 move wasn't correct
(loop for elem across *test-array*
do (print elem))
(defparameter *test-array* (make-array 7 :initial-contents '(1 -3 2 3 -2 0 4)))
(move-elem-by-itself *test-array* -3)
;; 0 -> 0
;; -1 -> (len - 1)
;; -2 -> (len - 2)
(mod -1 7)
;; so, just hack it? when we move to the left, we add one more?
;; so, ugh and when moving to positive, but going over the what
;; the number is not "switched" with the neighbor, it's jumping over the neighbor...
;; so, if we go to 0 or to len-1 then we jump to the other side?
(defparameter *test-array* (make-array 7 :initial-contents '(1 -3 3 -2 2 0 4)))
(move-elem-by-itself *test-array* 2)
(defparameter *test-array* (make-array 7 :initial-contents '(1 -3 3 -2 2 4 0)))
(move-elem-by-itself *test-array* 4)
(defparameter *test-array* (make-array 7 :initial-contents '(1 2 -3 0 3 4 -2)))
(move-item *test-array* 5 4)
(move-elem-by-itself *test-array* 4)
;; now this incorrect:
;; after moving 3, arr: #(1 2 -2 -3 0 3 4)
;; after moving -2, arr: #(-2 1 2 -3 0 3 4)
;; -2 should have went instead of to 0 straight to the end. so
;;
;; and now it works
;; god i also need to take 1000th value with overbound. ugh.
(defun get-ugh-nth (arr n)
(let* ((zero-ind (position 0 arr))
(unsafe-index (+ zero-ind n))
(safe-n (mod unsafe-index (length arr))))
(aref arr safe-n)))
(get-ugh-nth (mixing-array *test-array*) 1000)
(get-ugh-nth (mixing-array *test-array*) 2000)
(get-ugh-nth (mixing-array *test-array*) 3000)
;; uh. after the value 0...
;; so first find index of 0
(let* ((nums (mapcar #'parse-integer (uiop:read-file-lines "day20-input.txt")))
(input-arr (make-array (length nums) :initial-contents nums))
(mixed (mixing-array input-arr)))
(+ (get-ugh-nth (mixing-array mixed) 1000)
(get-ugh-nth (mixing-array mixed) 2000)
(get-ugh-nth (mixing-array mixed) 3000)))
;; 1797 is too low,
(defun part-1-ans (filename)
(let* ((nums (mapcar #'parse-integer (uiop:read-file-lines filename)))
(input-arr (make-array (length nums) :initial-contents nums))
(mixed (mixing-array input-arr)))
(+ (get-ugh-nth mixed 1000)
(get-ugh-nth mixed 2000)
(get-ugh-nth mixed 3000))))
;; (part-1-ans "day20-test.txt")
;; (print (part-1-ans "day20-input.txt"))
;; well, do we have duplicates?
(ql:quickload :fset)
(fset:set 1 2 3)
(fset:set '(1 2 3))
(print (let* ((nums (mapcar #'parse-integer (uiop:read-file-lines "day20-input.txt")))
(input-arr (make-array (length nums) :initial-contents nums))
(input-set (fset:convert 'fset:set nums))
)
(list 'arr (length input-arr) 'set (fset:size input-set))
))
;; (ARR 5000 SET 3613)
;; well, yupikayey
;; how should i be doint that?
;; AND i should have checked that from the start.
;; so. there are duplicates.
(fset:convert 'fset:bag '(1 2 3 2 4 5))
;; what should i do about the duplicates?
;; i'd need to store elements with their initial indexes i suppose
;; and then what? iterate not over initial collection, but just over "initial" indexes
;; yay, at least previous solution was still incorrect. yayyayay
;;; PART 2.
;; wowy.
;; 1. multiply all numbers by 811589153
;; 2. do 10 mixings
(map 'vector #'1+ (aops:linspace 0 9 10))
(defun part-2-ans (filename)
(let* ((data (map 'vector (lambda (zipped) (list (first zipped) (* 811589153 (second zipped))))
(input-arr filename)))
;; (mixed (mixing-array input-arr))
(mixed (do* ((arr data (mixing-array arr))
(iteration 0 (1+ iteration)))
((= 10 iteration) arr))))
(format t "getting part 1, mixed array: ~a~%" mixed)
(+ (get-ugh-nth mixed 1000)
(get-ugh-nth mixed 2000)
(get-ugh-nth mixed 3000))))
(print (part-2-ans "day20-test.txt"))
(print (part-2-ans "day20-input.txt"))

7
day20-test.txt Normal file
View File

@@ -0,0 +1,7 @@
1
2
-3
3
-2
0
4

136
day20.lisp Normal file
View File

@@ -0,0 +1,136 @@
;; https://adventofcode.com/2022/day/20
(defpackage :day-20
(:use :cl))
(in-package :day-20)
(ql:quickload :array-operations)
(ql:quickload "fiveam")
(ql:quickload 'alexandria)
(5am:def-suite day20-tests)
;; and shift some slice 1 to right
(defun move-item-to-left (array moved-index move-size)
(declare (optimize (debug 3)))
(let* ((move-size (mod move-size (1- (length array))))
(moved-value (aref array moved-index))
(move-by (- (mod move-size (length array))))
(moving-slice-size move-size)
(to-be-moved (make-array moving-slice-size :displaced-to array
:displaced-index-offset (+ moved-index move-by)))
(into-these-move (make-array moving-slice-size :displaced-to array
:displaced-index-offset (+ moved-index move-by 1))))
(loop
for i from (1- move-size) downto 0
do (setf (aref into-these-move i)
(aref to-be-moved i)))
(setf (aref array (+ moved-index move-by)) moved-value)
array))
(5am:def-test move-left-inside-of-array (:suite day20-tests)
(5am:is (equalp (make-array 10 :initial-contents '(0 1 2 6 3 4 5 7 8 9))
(move-item-to-left (aops:linspace 0 9 10) 6 3))))
(5am:def-test move-left-to-edge (:suite day20-tests)
(5am:is (equalp (make-array 10 :initial-contents '(6 0 1 2 3 4 5 7 8 9))
(move-item-to-left (aops:linspace 0 9 10) 6 6))))
(5am:def-test move-by-arr-size-leaves-intact (:suite day20-tests)
(5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 6 7 8 9))
(move-item-to-left (aops:linspace 0 9 10) 6 9))))
(5am:def-test move-by-more-than-arr-size (:suite day20-tests)
(5am:is (equalp (make-array 10 :initial-contents '(0 1 2 6 3 4 5 7 8 9))
(move-item-to-left (aops:linspace 0 9 10) 6 12))))
(defun move-item-to-right (array moved-index move-by)
(declare (optimize (debug 3)))
(let* ((move-by (mod move-by (1- (length array))))
(moved-value (aref array moved-index))
(moving-slice-size move-by)
(to-be-moved (make-array moving-slice-size
:displaced-to array
:displaced-index-offset (+ moved-index 1)))
(into-these-move (make-array moving-slice-size
:displaced-to array
:displaced-index-offset moved-index)))
(loop
for i from 0 below move-by
do (setf (aref into-these-move i)
(aref to-be-moved i)))
(setf (aref array (+ moved-index move-by)) moved-value)
array))
(5am:def-test move-right-inside-of-array (:suite day20-tests)
(5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 7 6 8 9))
(move-item-to-right (aops:linspace 0 9 10) 6 1))))
(5am:def-test move-right-to-edge (:suite day20-tests)
(5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 7 8 9 6))
(move-item-to-right (aops:linspace 0 9 10) 6 3))))
(5am:def-test move-right-by-arr-size-leaves-intact (:suite day20-tests)
(5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 6 7 8 9))
(move-item-to-right (aops:linspace 0 9 10) 6 9))))
(5am:def-test move-right-by-more-than-arr-size (:suite day20-tests)
(5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 7 8 9 6))
(move-item-to-right (aops:linspace 0 9 10) 6 12))))
(defun move-item (array move-index move-by)
(let* ((raw-target-index (if (>= move-by 0)
(+ move-index move-by)
(+ move-index move-by)))
(in-array-target-index (mod raw-target-index (1- (length array))))
(in-array-target-index (if (= 0 in-array-target-index)
(1- (length array))
in-array-target-index ; a hack
))
(safe-move-by (- in-array-target-index move-index)))
;; (list move-index move-by
;; 'raw-target raw-target-index
;; 'in-array-target in-array-target-index
;; 'safe-move-by safe-move-by)
(if (> safe-move-by 0)
(move-item-to-right array move-index safe-move-by)
(move-item-to-left array move-index (- safe-move-by)))
))
;; we know the element value, but not it's place
(defun move-elem-by-itself (array initial-index)
(declare (optimize (debug 3)))
(let ((i (position initial-index array :test (lambda (searched-index zipped)
(= searched-index (car zipped))))))
(move-item array i (second (aref array i)))))
(defun mixing-array (arr)
(let ((to-be-modified (alexandria:copy-array arr)))
(loop
for initial-index from 0 below (length arr)
;; for elem across arr
do (progn (move-elem-by-itself to-be-modified initial-index)
;; (format t "after moving ~a, arr: ~a~%" elem to-be-modified)
))
to-be-modified))
(defun zip-with-index (ls)
(loop for v in ls
for i from 0
collect (list i v)))
(defun input-arr (filename)
(let ((nums (mapcar #'parse-integer (uiop:read-file-lines filename))))
(make-array (length nums) :initial-contents (zip-with-index nums))))
(defun get-ugh-nth (arr n)
;; need to find 0 by value in the (index, value) array
(let* ((zero-ind (position 0 arr :test (lambda (searched-value zipped)
(= searched-value (second zipped)))))
(unsafe-index (+ zero-ind n))
(safe-n (mod unsafe-index (length arr))))
(second (aref arr safe-n))))
(defun part-1-ans (filename)
(let* ((input-arr (input-arr filename))
(mixed (mixing-array input-arr)))
(format t "getting part 1, mixed array: ~a~%" mixed)
(+ (get-ugh-nth mixed 1000)
(get-ugh-nth mixed 2000)
(get-ugh-nth mixed 3000))))
(5am:run! 'day20-tests)

2979
day21-input.txt Normal file

File diff suppressed because it is too large Load Diff

135
day21-scratch.lisp Normal file
View File

@@ -0,0 +1,135 @@
;; // https://adventofcode.com/2022/day/21
;; well, this seems like this could be done with (eval)
;; would it be possible for me to also translate
;; xxx + yyy into (call xxx) + (call yyy)
;; that would be neat
(in-package :day-21)
;; so. have mashmap from symbol name into operation
;; and have (my-eval)?
;; it will take symbol name, and either return number directly from the map
;; or will wrap the names into my-eval and run operation on them?
;; is there a way to have less code and reuse existing lisp things?
;; if there's direct number, i could just run (defparameter lfqf 4)
;; and then execute root directly, i think
;; or what, i'd need to also define all the intermediate symbols,
;; (setq a (+ c d)) ; complains that C is unbound
;; how could this be a lazy eval?
;; well. hm
;; i could define all of these as macroses?
(defmacro *test-monkey-hmdt* () 32)
(+ 3 (*test-monkey-hmdt*))
;; yup, i guess
(defparameter *test-monkey-sllz* 4)
(eval *test-monkey-sllz*)
(defparameter *test-monkey-ljgn* 2)
(defparameter *my-operation* '(+ *test-monkey-sllz* *test-monkey-ljgn*))
*my-operation*
(eval *my-operation*) ; well, that works ok
;; so, read all of these things as parameters.
;; "root: pppw + sjmn "
(mapcar #'intern (ppcre:split " " "root: pppw + sjmn "))
(mapcar #'parse-integer-or-symbol (ppcre:split " " "root: 44"))
(ppcre:regex-replace ":" "root: pppw + sjmn " "")
(line-to-quoted-operation "root: pppw + sjmn")
(eval (line-to-quoted-operation "dbpl: 5"))
;; well, i'd want to put quoted expression into parameter?
;; and now i can remove quoting of the defparameter?
;; and actually define all of the parameters?
(loop
for line in (uiop:read-file-lines "day21-test.txt")
for definition = (line-to-quoted-operation line)
do (eval definition))
(eval root)
;; (load-file-defs "day21-test.txt")
;; (eval root)
;; (load-file-defs "day21-input.txt")
;; (print (eval root))
;; now. things are different.
;; HUMN is my input
;; and ROOT is "comparison of two numbers"
;; and change in root can influence results in a significant way
;; so, how'd i do that?
;;
;; what could be done then?
;; i could potentially somehow modify the operations?
;; so that (eval humn) would return
;;
;; root: pppw + sjmn
;; so. root should mean
;; pppw == sjmn
;; don't know which has HUMN yet.
;; should i then just eval those that have HUMN into a operation?
;; and others into a number?
;; well, i suppose i'd need to do pass down somehow
;; eval both parts of the root.
;; and then what?
;;
;; let's skip for now?
;; or, alternatively. i could save HUMN num disregard
;; defparameter with HUMN to be used as HUMN =
;; and then what? root
;; but then i'd need to reverse all the other operations, hm
;; or, maybe i could join into flat expression?
;; and then what? i macroexpand?
;;
;; now. i had an idea. i could have additional symbols,
;; also pointing to quoted computations
;; but these would be `back-ptdq`
;; for line 'lgvd: ljgn * ptdq'
;; make two? for each
;;
;; ptdq: humn - dvpt
;; back-humn = ptdq + dvpt
;; but one of these wouldn't be possible to forward eval, so it would be back-ptdq + dvpt
;; and on
;; root: pppw + sjmn
;; two would be created back-pppw = - eval sjmn and vice versa
;; this should work?
;; sure, let's try?
;; so we'd do what?
;; same for forward eval?
;; and two for back-monkey
(back-symbol 'hello)
(intern (format nil "BACK-~a" 'yo))
;; and i need reverse of the operands?
(reverse-operation '+)
(line-to-quoted-operation-2 "dbpl: 5")
(line-to-quoted-operation-2 "pppw: cczh / lfqf")
(line-to-quoted-operation-2 "lgvd: ljgn * ptdq")
(line-to-quoted-operation-2 "drzm: hmdt - zczc")
(line-to-quoted-operation-2 "cczh: sllz + lgvd")
(line-to-quoted-operation-2 "root: pppw + sjmn")
;; i think it's done? let's try to eval all of this?
;; but i also need root back-computation.
;; for each operant that they are equal to forward calculation of another
;; (load-file-defs-2 "day21-test.txt")
;; (eval root)
;; (eval back-humn) ; 301. cool
;; (load-file-defs-2 "day21-input.txt")
;; (print (eval back-humn))
;; 3715799488132

15
day21-test.txt Normal file
View File

@@ -0,0 +1,15 @@
root: pppw + sjmn
dbpl: 5
cczh: sllz + lgvd
zczc: 2
ptdq: humn - dvpt
dvpt: 3
lfqf: 4
humn: 5
ljgn: 2
sjmn: drzm * dbpl
sllz: 4
pppw: cczh / lfqf
lgvd: ljgn * ptdq
drzm: hmdt - zczc
hmdt: 32

98
day21.lisp Normal file
View File

@@ -0,0 +1,98 @@
;; // https://adventofcode.com/2022/day/21
(defpackage :day-21
(:use :cl))
(in-package :day-21)
(ql:quickload 'cl-ppcre)
(defun parse-integer-or-symbol (str)
(let ((maybe-int (parse-integer str :junk-allowed t)))
(if maybe-int
maybe-int
(intern (string-upcase str)))))
(defun line-to-quoted-operation (line)
(let* ((words (ppcre:split " " (ppcre:regex-replace ":" line "")))
(symbols (mapcar #'parse-integer-or-symbol words)))
(cond
((= 4 (length symbols))
;; with operation
(destructuring-bind (name operand1 op operand2)
symbols
`(defparameter ,name '(,op (eval ,operand1) (eval ,operand2)))))
((= 2 (length symbols))
;; just number
(destructuring-bind (name value)
symbols
`(defparameter ,name ,value))))))
(defun load-file-defs (filename)
(loop
for line in (uiop:read-file-lines filename)
for definition = (line-to-quoted-operation line)
do (eval definition)))
(defun reverse-operation (op)
(case op
('* '/)
('/ '*)
('+ '-)
('- '+)))
(defun back-symbol (symb)
(intern (format nil "BACK-~a" symb)))
;; adding BACK-symbol computations.
(defun line-to-quoted-operation-2 (line)
(let* ((words (ppcre:split " " (ppcre:regex-replace ":" line "")))
(symbols (mapcar #'parse-integer-or-symbol words)))
(cond
((= 4 (length symbols))
;; with operation
(destructuring-bind (name operand1 op operand2)
symbols
(if (eq name 'ROOT)
`(progn (defparameter ,(back-symbol operand1) '(eval ,operand2))
(defparameter ,(back-symbol operand2) '(eval ,operand1)))
(let ((forward-calc
`(defparameter ,name '(,op (eval ,operand1) (eval ,operand2))))
(backward-calc
(case op
('+ `((defparameter
,(back-symbol operand1)
'(- (eval ,(back-symbol name)) (eval ,operand2)))
(defparameter
,(back-symbol operand2)
'(- (eval ,(back-symbol name)) (eval ,operand1)))))
('- `((defparameter
,(back-symbol operand1)
'(+ (eval ,(back-symbol name)) (eval ,operand2)))
(defparameter
,(back-symbol operand2)
'(- (eval ,operand1) (eval ,(back-symbol name))))))
(t `((defparameter
,(back-symbol operand1)
'(,(reverse-operation op) (eval ,(back-symbol name)) (eval ,operand2)))
(defparameter
,(back-symbol operand2)
'(,(reverse-operation op) (eval ,(back-symbol name)) (eval ,operand1)))))
)))
`(progn
,forward-calc
,@backward-calc
;; (defparameter ,(innern (format t "BACK~a" name) ))
)))))
((= 2 (length symbols))
;; just number
(destructuring-bind (name value)
symbols
`(defparameter ,name ,value))))))
(defun load-file-defs-2 (filename)
(loop
for line in (uiop:read-file-lines filename)
for definitions = (line-to-quoted-operation-2 line)
do (eval definitions)))

200
day22-map.txt Normal file
View File

@@ -0,0 +1,200 @@
......#....#.#........................................#.......##...........#.............#......#...
..............#..#........#......##........................#......#....#........................#...
.....................#.........#...#.#........#..............................#....#........#..#.....
.........#.........##................................#.....#.........#...........#...........#......
..........#.............#.....##.......#..#..........##......#.#...........#............##..........
......#.............##.........#.....#....#...............................................#.......#.
..#......#......#.........#..#.........#....#...................#...........#...#.....##.#..#...#..#
#.#.............#.............#.#......#.....#.....#.##.##.....#...#..#...............#.............
.#....#...##....#...................#..#............................................#.........#.....
....#..##....#..#....#..............#..#...#...#................#...........#..#..#............##...
..#.#....................................................................#.....##....##.....#..#....
.......#...#......#...##........#...#......................#.#.#..............#...#..#.....#........
.....#.#..#........#..............##......#........##...............#..................#.....#......
.......#...............#...#...................................#............#.......................
......#..##.....#.......#....#..................................................#.#.......#.........
................#..#..#....#.#.....................#................................................
.................#.#........#.....##...#...#.#..#....#....#.............#...#..................#..#.
.#...................#......#..#...............#.............#.........................#...#.....#..
...#.#...................#...#.........................#.......##.......................#.........#.
.#.............................#........##.........#.#.....##.....................#....#...........#
..........#.....#..............................#................##.....................#.......#....
.....................................#....##..........#...............#.......##.........#.#........
....#.###............#....#..........#..........#.......................#...............#....#.#....
.#...#...#...............#.........#........................#.................#..................#.#
.................#......#.....................#........#......#.....................#....#.##.......
##..#....................#.....................#....#....#.....#.............................#.....#
#...#.......................................................##.#...#.........#..#...................
............#......#.....#........#..#.#......#.#.............#....#......#.#...............#.......
..................................................#.#..........##.........##......#.#.#.........##..
..#..........................#.......#..#..#.......#.................###.......#...........#..#...##
..#.....#..#...#.....#.....#...#..#.................................#.....#.........#.............#.
............#.#..#..##..#.#.##....#...............#.......#........#............#........#..........
.#...........#...........................#............#.....#.#.........#.....#.......###...#.......
...#.......................#.........................#...##........#.....................#.......#..
...........#..#.............................#.................#..##...#.............................
..................#.#...#..#....#....#..........#................#..#.........#......#.......#......
...#...#....#.#................#.............#.............................#..#.....................
....................#.........#..#.#...#.#.##...#...#..............#.......#.........#.............#
...#.....#.............##.....#....#.#.......#......................................................
..........#..#...#.......................#.................##.....#........#...#......#.......#.....
........#......#...............#.#.....#...........................#.....................#.......#..
..................................#...........#......#...........#.............#....###.............
................#.......................#.#......#.##..........#......#............#................
.........................................#..........................................##...........#..
...#.......#....##.#....#...............#..#...#.............#...#....#.....#.#...........#.........
#........#...........#...........#.....................#........#..................#.....#......#...
........#.....##..#.........................#....#..........#.##..#.......#.#.................#...#.
..........................#.............................#........#............#.............#....#..
.............................#..................................................#...................
................#.............#..#..........##......#......#.........#...........##............##...
#...#.......#.............#............#..........
#................#...#....#..................#....
.................#.....#.#....#......#...#........
..................................#...............
.....#...............................#............
...............#............##..........#.......#.
#............#.....................###.#.........#
.#...............#...........#....#......#........
.#.............###.#................#........#....
....##............#..........#.#.........#.#.#....
..................#..#..............#......#......
....#.............................#...............
.#.#..........#...........#......##...............
..........#......#....#...#.#....#..#.............
................#...............#.................
..........#..#...#..............#...............#.
...#..............##..............#...............
..#...#.#....#.........#.........#.......#........
.................#..............#.........#.....#.
.......#........#......#............#......#......
..........#..............#....#..#............#...
.......#............#.............#...............
.....#.#..........#.#..........#..................
#...#...................#......#......#.....#.....
........#........##.#.......##................#...
..................#.........................##....
..#................#..............#.#....#.#.#...#
........#..........................#..........#...
..#.......#.#............#..........#.....#.......
....#....#...............................#........
..#............................................#..
....#.......#..............##.......#......##.....
.#..........#......#....#.#........#..............
................#.#.......##.............###.....#
...............#......##.#...#................#...
....#.......#....##...#..#..........#.........#...
.....#.........#...#...........#........#.........
.......#...............#..................#.......
...........#.....#.........#........#....#.......#
..#.....................................#...#.....
..................#..............#....#.#.........
........................#.......#.#......#........
...#......#..#..........#..#..#........#..........
.....#.......#.........#.............#.......#....
......#......#...............#.....#.........#....
.#.........................#.....#.............#..
...#......#.#.....##...#.#....#.#...............#.
.............#........#.#.#.....#.................
...#.........#.........#....#.................##..
.......#.......##...#....#..........#.#...........
..#......#....................#.........#........#.....................#............#.....#.........
.##...........##...................#.#..................................#...........................
....#............#..........#..........................#...#......................#....##...........
.#...........#........................#..............................#..#...................#......#
#................#.#........#...........................#....................#...........#..........
#.....................#.....#.......##....#......#..##...#...........#...................#..........
.........#..#......#....#......#....#.......#.....................................................##
..#...#......##.#..................#.......#.............#....#....#.........#..............#.....#.
...........#...#...#.#........#..................##...........#.....#...............................
.............................#....##..#..#..........#.............................#.................
...#.................#...#...#...#.................................................#..............##
......#........#........#.........##....#....#.....#.......#.............#...##.##.#................
..#.......................#....................#..#...#.................#......#..........#......#..
.........................#....#..##..............#.............#.#...#....#.......#...#....#.....#..
....#................#.#...........................#....#..#.......##.#.....#................#.#....
..#.......................#.....#...#..#..#...#...#.............................#............#......
#..............................................#.......................................##........#.#
..............#.#............##..........#.........................#..................#.#...........
.....#......................#...........#.....#.................#................#........#...#..#.#
......#.#....#......#.#..................#.#................#.#.#...........#............#.....#....
.#......#......##..............#.........#.#.#.#..................#...#..........#..................
...#...........#.............#....#.#...#....#.......................#.#.....#.....#..............#.
...#...#.#.........#...#............#....#.........#.....#......#..#...........#.....#......#.......
.#.....#..........#..............#..#........#..............#...#.............#.#.......#..#........
.....#........................#.....#......#...............##..#.#...#...#.#............#...........
.....#......#.........#....#.......##.......#.##..................#...............#......#........#.
.#..#..#..#.................................#......#.#............#..#....#...................#.....
.#..#...........................#....#............................................................#.
......#..............................#..#.......#.........##..........##...#........................
............#...............#..#..#..........#......................#...#.#............#............
...##..................#.....#.........#......#...........#.......#.....#.......................#...
..#..#..#......#......#.....#.......#.................##..#.........................................
............#...##...#..........#.................................##....#........##........#........
...##...#....#....#........................#.............##.........................##.......#......
.............##..................#...................##.......#........##.............#.#..........#
.......#.....#...##..............#..........................#..........#..........#..#.............#
............#...#........#........#...............#.....#.....#.......#..............#.....#......#.
...........#.....#..##.................#......#........#.#.....................#....................
.....#......#.........#..........#..#......................................................##.......
..........#.....#......#.#.........#.....#..................##.............................#........
##......#...#..........#...............#.............#........#..................#........#........#
..#.........#...........#.......#...........##...................#.................#.#.....#...#....
...#.........#..................................#.....#..#............#.............#.#.............
....#...........#..........#..............#..###........#..#.........#....................#.#.......
..#..........#..#...............................#...#.................#............#............#.#.
.....................#.............#....#..#....#......................#..#......#..................
........#.#.............#....#...#.#.....#..........#................#.......#........#....#.#.....#
##.........................##....#...............#..........#......................##...............
.........#..................................#........................#....#............#...#.#......
........#........................#..#...#..........................#................................
................#..#.......#..#...................
.............#........#...................#.......
..#....#.......................#..........#...#..#
..........#.....................#..............#.#
.........#...#...#..............#..#.........#....
...........#.....#................................
.......#..#..#.......#............#...............
.........................#..........#..#....#..#..
#...........#....#.....#....#.#..#.......#........
#.#.......#.....#........#....#...#...............
..............................................#...
#......#....................................#...#.
........##..#.....#.#......#.........#..##....#...
...............#.........#...#.......#......#..#..
..........#.#......#.....#........................
.....#.....#......................................
..#..#............#.......#.....#..#.......#...#..
...............##....#........#..#.............#.#
..............#..................#.....#......#...
#.......#.......#...#...............#.#....#......
#.........#........#..........#........#....#.....
.....###.#...........#...........##............#..
.........#..##.......#......................#.....
.....#.##......#.......#...#.............#........
##.................#.....#.............#....#...#.
........#..............#.#.........#.......#......
........#..#.#.....#.............#............#..#
.#.....#.#..#..#.##........#..........#.....##....
.....#....#.........#.............................
................#..#....#.....#....#........#..#..
#.#............#.....#.............#.........#....
...#....#..........#.#.................#.#..#...#.
........#................#...#......#......#...#.#
..#.............#....#.......#..............#.....
.....................................##.........#.
............#.#...................................
..#...........................#..........#........
...#.............#..............#..........#...#..
#......#...#...#...#...#..................#....#..
....#......#..#....#.#.#..........................
..#.......................#..............#..#.....
................#........#...#..........#.#.......
....#...#......#...................#.#.#...#....#.
............#..............#........#..#.....#....
..........#...............#.......#...............
#....................#.......#...........#........
.......#.........#..........#.#..#.#..............
..#.........##......................#...#.........
...#.................#.##............#........#...
....#......#..#.....................#.............

1
day22-path.txt Normal file

File diff suppressed because one or more lines are too long

229
day22-scratch.lisp Normal file
View File

@@ -0,0 +1,229 @@
;; https://adventofcode.com/2022/day/22
(in-package :day-22)
;; monkey map. so, i'd want to store the map.
;; and have functions that return "neighbors" maybe as alist?
;; neighbor is the right place to calculate wrapping around empty space
;; on top of neighbors get walkable directions
;; how to best represent coord?
;; next - moving
;; looking at the map of input. maybe somehow precompute where to jump on the map?
;; nah.
;; so, let's get map. with chars space, dot, hash
;; have line of spaces at the start, end, left and right?
;; that would shift coords by +1
;; and i'd also like what? i'd also like to store the path?
;; when exiting save that last orientation at the point?
;; and only treat space and hast as special, dot and arrows as walkable
;; or i could print "every snapshot" with setting and removing the walkout
;; i could split the input into files, that would simplify things
;; let's read the map into array?
(setq *ugh*
(let* ((lines (uiop:read-file-lines "day22-test-map.txt"))
(rows (length lines))
(cols (apply #'max (mapcar #'length lines)))
(arr (make-array (list (+ 2 rows) (+ 2 cols)) ; adding for padding row of empty space
:initial-element #\ )))
(loop for row from 0 below rows
for line = (coerce (nth row lines) 'array)
do (loop for col from 0 below cols
for char = (if (array-in-bounds-p line col) (aref line col) #\ )
do (setf (aref arr (1+ row) (1+ col)) char)))
arr))
(setq *test-arr-out-bounds* (make-array '(2 2) :initial-element #\. :adjustable t))
(print-map *ugh*)
;; yep, this is what i want
(print-map (read-map-to-array "day22-map.txt"))
(setq *ugh* (read-map-to-array "day22-test-map.txt"))
;; seems to work.
;; what are next steps?
;;
;; for some coords get neighboring to four sides
;; this should just return coords even with wrapping
;; let's first do function that returns coord or wrapped coord if value is space?
(alexandria:assoc-value *movements* 'left)
;; so from coord as list to updated coord
(move-coord-one-step '(1 1) 'right)
;; next should check the value of the moved. and if it's space -
;; calculate wrap
;; would also take the map array
;; if we're out of bounds, just skip this movement. shouldn't happen in my data
(opposite-movement 'left)
(opposite-movement 'right)
(opposite-movement 'down)
(opposite-movement 'up)
(apply #'aref *ugh* '(1 12))
;; now i need to check that. hm.
*ugh*
(print-map *ugh*)
'(4 1) ; begining of part
(move-with-possible-wrap '(5 1) 'left *ugh*)
(aref *ugh* 5 0)
(let ((coord '(5 1))
(map *ugh*)
(direction 'left))
(do
((mov-coord coord
(move-coord-one-step mov-coord (opposite-movement direction))))
((equal #\ (apply #'aref map mov-coord)) (move-coord-one-step mov-coord direction))))
;; now? um
(move-with-possible-wrap '(5 2) 'up *ugh*) ; now that seems ok
;; next is from 'move-with-possible-wrap
;; i guess i'd alreay want to display?
;; set X on that coord?
(display-coord '(5 2) *ugh*)
(display-coord (move-with-possible-wrap '(5 2) 'up *ugh*) *ugh*)
;; yeah, kind of ok.
;; what next? simulate movement?
(move 4 'right '(1 1) *ugh*)
(display-coord '(6 1) *ugh*)
(display-coord (move 4 'right '(6 1) *ugh*) *ugh*)
(display-coord '(6 8) *ugh*)
(display-coord (move-with-possible-wrap '(6 8) 'left *ugh*) *ugh*)
(display-coord (move 1 'left '(6 8) *ugh*) *ugh*)
(display-coord (move 2 'left '(6 8) *ugh*) *ugh*)
(display-coord (move 3 'left '(6 8) *ugh*) *ugh*)
(display-coord '(6 8) *ugh*)
(display-coord (move-with-possible-wrap '(6 8) 'right *ugh*) *ugh*)
(display-coord (move 1 'right '(6 8) *ugh*) *ugh*)
(display-coord (move 2 'right '(6 8) *ugh*) *ugh*)
(display-coord (move 3 'right '(6 8) *ugh*) *ugh*)
(display-coord '(6 2) *ugh*)
(display-coord (move-with-possible-wrap '(6 2) 'left *ugh*) *ugh*)
(display-coord (move 1 'left '(6 2) *ugh*) *ugh*)
(display-coord (move 2 'left '(6 2) *ugh*) *ugh*)
(display-coord (move 3 'left '(6 2) *ugh*) *ugh*)
(display-coord (move 4 'left '(6 2) *ugh*) *ugh*)
(display-coord (move 5 'left '(6 2) *ugh*) *ugh*)
(display-coord (move 6 'left '(6 2) *ugh*) *ugh*)
;; ok, i guess
;;
;; and now code the walk?
(defparameter *test-path* "10R5L5R10L4R5L5")
(ppcre:split "(L|R|U|D])" *test-path* :with-registers-p t )
;; somewhat of what i want, but also lrud into words
(mapcar #'parse-integer-or-symbol
(ppcre:split "(L|R)" *test-path* :with-registers-p t ))
;; initial number is "forward" from initial direction
;; oh, so the path is with turns Right turn or Left turn.
;; with initial Right
;; so, now i'd want a fuction that transformes direction
;; i guess i could what? make cyclic list? not quite i guess
(alexandria:circular-list 'up 'right 'down 'left)
(position 'up (alexandria:circular-list 'up 'right 'down 'left))
(nth (mod -1 4) (alexandria:circular-list 'up 'right 'down 'left))
;; yeah i guess
(new-direction 'UP 'L)
(new-direction 'LEFT 'L)
(new-direction 'down 'L)
(new-direction 'right 'L)
(new-direction 'UP 'R)
(new-direction 'LEFT 'R)
(new-direction 'down 'R)
(new-direction 'right 'R)
;; yay. that's kind of ok
;; now. ugh
;; yup, let's add that in code...
(append (read-path "day22-test-path.txt") (list 'L))
(read-path "day22-path.txt")
;; the path is "go N to your direction"
;; then L or R to change direction
;; so, now the main loop?
;; i guess i could add one more R or L to the end
;; and treat path as (n turn-direction)
;; oh, but the final direction is part of the answer
;; OK, LET'S add L to the end
(let ((padded-path (append (read-path "day22-test-path.txt") (list 'L)))
(direction 'right)
(coords '(1 1)) ; to be calculated
(map *ugh*)
)
(loop
for (n turn-direction) on padded-path by #'cddr
do (progn
(setq coords (move n direction coords map))
(setq direction (new-direction direction turn-direction)))
finally (return (list coords direction))))
;; hoho. the task requires indices starting from 1, cool
;; and i did 1 too many left turns, so let's turn right
;; UP to right, is RIGHT
;; and 0 for right, cool
;; yay! now let's clean it up.
;; one more thing. determining top leftmost point.
(get-topmost-left-coords *ugh*)
(print-map *ugh*)
(apply #'calc-password (walk-path "day22-test-path.txt" "day22-test-map.txt"))
(apply #'calc-password (walk-path "day22-path.txt" "day22-map.txt"))
;; 11464
;; and one gold star.
;;; and PART 2.
;; then neighbors is different
;; especially the wrap thing.
;; how'd i calc that? for the map? ugh
;; so, it's 6 parts. huh. ugh
;; oh, they're oblong, but they are all 4 by 4
;; XX
;; X
;; XX
;; X
;; outline of my input
;; how do i get freaking folding?
;; ugh.
;; maybe go for the next? um.
;; yeah. i'm giving up for now. let's go to rest for the new years. 19:33 of Dec 31st
;; fare well Common Lisp, I'll return to use in Q2 or Q3

12
day22-test-map.txt Normal file
View File

@@ -0,0 +1,12 @@
...#
.#..
#...
....
...#.......#
........#...
..#....#....
..........#.
...#....
.....#..
.#......
......#.

1
day22-test-path.txt Normal file
View File

@@ -0,0 +1 @@
10R5L5R10L4R5L5

141
day22.lisp Normal file
View File

@@ -0,0 +1,141 @@
;; https://adventofcode.com/2022/day/22
(defpackage :day-22
(:use :cl))
(in-package :day-22)
(ql:quickload 'alexandria)
(ql:quickload 'fiveam)
(ql:quickload 'cl-ppcre)
(5am:def-suite :day-22-test)
(defun read-map-to-array (filename)
(let* ((lines (uiop:read-file-lines filename))
(rows (length lines))
(cols (apply #'max (mapcar #'length lines)))
(arr (make-array (list (+ 2 rows) (+ 2 cols)) ; adding for padding row of empty space
:initial-element #\ )))
(loop for row from 0 below rows
for line = (coerce (nth row lines) 'array)
do (loop for col from 0 below cols
for char = (if (array-in-bounds-p line col) (aref line col) #\ )
do (setf (aref arr (1+ row) (1+ col)) char)))
arr))
(defun print-map (arr)
(loop for row from 0 below (array-dimension arr 0)
do (let ((line (make-array (array-dimension arr 1)
:displaced-to arr
:displaced-index-offset (* row (array-dimension arr 1)))))
(format t "~a~%" (coerce line 'string))
)))
(defconstant *movements*
'((left . (0 -1))
(right . (0 1))
(down . (1 0))
(up . (-1 0))))
(defun opposite-movement (movement)
(let ((alist '((left . right) (down . up))))
(or (alexandria:assoc-value alist movement)
(alexandria:rassoc-value alist movement))))
(defun move-coord-one-step (coord direction)
(mapcar #'+ coord (alexandria:assoc-value *movements* direction)))
(5am:def-test move-coord-left (:suite :day-22-test)
(5am:is (equalp (move-coord-one-step '(2 2) 'left)
'(2 1))))
(5am:def-test move-coord-right (:suite :day-22-test)
(5am:is (equalp (move-coord-one-step '(2 2) 'right)
'(2 3))))
(5am:def-test move-coord-up (:suite :day-22-test)
(5am:is (equalp (move-coord-one-step '(2 2) 'up)
'(1 2))))
(5am:def-test move-coord-down (:suite :day-22-test)
(5am:is (equalp (move-coord-one-step '(2 2) 'down)
'(3 2))))
(defun move-with-possible-wrap (coord direction map)
(let ((initial (move-coord-one-step coord direction)))
(if (not (equal #\ (apply #'aref map initial)))
;; when not wrapping
initial
;; when map on initial movement is empty - wrap
(do
((mov-coord coord
(move-coord-one-step mov-coord (opposite-movement direction))))
((equal #\ (apply #'aref map mov-coord)) (move-coord-one-step mov-coord direction))))))
(defun display-coord (coord map)
(let ((copied (alexandria:copy-array map)))
(setf (apply #'aref copied coord) #\X)
(print-map copied)))
(defun move (n direction coord map)
(do* ((prev-coord coord next-coord)
(next-coord (move-with-possible-wrap coord direction map) (move-with-possible-wrap next-coord direction map))
(count 0 (1+ count)))
((or (= count n)
(equal #\# (apply #'aref map next-coord)))
prev-coord)
;; (format t "before move, iter ~a~%" n)
;; (display-coord prev-coord map)
;; (format t "after move, iter ~a~%" n)
;; (display-coord next-coord map)
))
(defun new-direction (direction turn-to)
(let* ((directions-cycle '(UP RIGHT DOWN LEFT))
(turn-mod '((L . -1) (R . 1)))
(cur-dir-pos (position direction directions-cycle))
(new-pos (mod
(+ cur-dir-pos (alexandria:assoc-value turn-mod turn-to))
4)))
(nth new-pos directions-cycle)))
(defun parse-integer-or-symbol (str)
(let ((maybe-int (parse-integer str :junk-allowed t)))
(if maybe-int
maybe-int
(intern (string-upcase str)))))
(defun read-path (filename)
(mapcar #'parse-integer-or-symbol
(ppcre:split "(L|R)" (uiop:read-file-string filename) :with-registers-p t )))
(defun get-topmost-left-coords (map)
(loop for col from 0 below (array-dimension map 1)
do (when (equal #\. (aref map 1 col))
(return (list 1 col)))))
(defun walk-path (path-filename map-filename)
(let* ((padded-path (append (read-path path-filename)
(list 'L)))
(direction 'right)
; to be calculated
(map (read-map-to-array map-filename))
(coords (get-topmost-left-coords map))
(walk-result
(loop
for (n turn-direction)
on padded-path by #'cddr
do (progn
(setq coords (move n direction coords map))
(setq direction (new-direction direction turn-direction)))
finally (return (list coords direction)))))
(destructuring-bind ((row col) over-direction)
walk-result
(list row col (new-direction over-direction 'R)))))
(defun calc-password (row col direction)
(let* ((direction-scores '((right . 0) (down . 1) (left . 2) (up . 3)))
(direction-score (alexandria:assoc-value direction-scores direction)))
(+ (* 1000 row) (* 4 col) direction-score)))
(5am:run! ':day-22-test)

129
day25-input.txt Normal file
View File

@@ -0,0 +1,129 @@
1-012=0=2=--12
11=
1=--000111=01-0
201-12=0211--
110-=010-01--02
11021==---22-1
122001
1--0
2-=2
22=02==01=0-2-011
12-2-00-11
20=0-2102=-01
1102=
122--0-112221
11=00-2=201-22=-=
10-02==210--=0
2=220-02=1202
1=--0-
2-122==
10-=00
1=001-22==1
1=121022122-1--0
11-
2=0-1-0-1
1=-0221-==
1-==-0--1012
1--02=-01=020110=
2-0212==1--=2=
112
1=-=1=0012201
1==-
1=02-2=012-=2--=--
1=220-1=0--=1
10-=
1-=22-111=211
11--==21==202
20-
1=-1=02=0=1===0-210
1==-0=010
1=-2=-=2-01-102102=
110-==0=2=-==-2-10
12200=--21-
21-=1-=1-2-
111-==2=2
210=-0-02=-0=11
10-1
1-0=011
20=10=001-
2-0=0-=1121=---2-0
22-1=2=0202
21=2201020211=2
1-110=
21=22=0-=1==121
1==-=01
1-1=1012==1
1-01===1=--21
1==
2-=
200=202121--0122
1-02
1=21=-12-0-
2-=10
121=-20=0200=02==1
101=2-2102-0-02=
1===11
22==0
22-21==-2-1220=10
1==2120--1-=
1=11-2=-110100002200
2211=2=-=-=01-01
1==-010==-=2-=
2=0=2
11-100-21=
11=1=-1=0
2=2--1=2
1-0==1=2-211=1
1-2=-202011211
10=-==-00-1==01
1-=2122==
112=-012
12==-0=
1122-0=0
1=2=0
2===-0=-0-0
1212
202
1==1
2111=1=000221-=-2=-
210111=2=0-1==-
1===00=
22=22=-1-==2-==
102--1=-1=222
2=--=--0-2
11-02=201101=2
1=
12--112-=0=
10====0=220
100020002=-0=02-1-
101
1=1-112-=
2022-02
22201212
21221201010210-1-
1-=1=-121-0-221-10
1=212=01--10-==
12-0=2121=21-2
111-2-00
1=20=202--
2-==2=--2-2101002
111-12=00
1=0===2=
12=-2020=1=2012
2=
1-02---
221---2122212
10=-20002=20-22
2010-220
12
2=0-=221
10011=0
1-20--=1=1-=1
1=1
1=0202-2-1=20-2-
101=--0-=-010-=
1=12=--
2=2111=
1=0-2=2120002=0
10-1=0---10=-20=010
20-121===--=2-=111

96
day25-scratch.lisp Normal file
View File

@@ -0,0 +1,96 @@
;; https://adventofcode.com/2022/day/25
(in-package :day-25)
;; so. from decimal to SNAFU and back...
;; or maybe direct sum in snafu?
;;
;; at least 16 digits in my input
(parse-integer (format nil "~a" '1)) ; kek
;; would rather have hashmap then? or array, i guess
;; no? list? alist is list of cons cells, no?
;; from SNAFU should be easier
;; 1=-0-2
(defparameter *test-snafu*
'((5 . 1) (4 . -2) (3 . -1) (2 . 0) (1 . -1) (0 . 2)))
(assoc 4 *test-snafu*)
(alexandria:assoc-value *test-snafu* 4)
(loop
for (pow . mul) in *test-snafu*
sum (* mul (expt 5 pow)))
(exp 2) ; e^2
(expt 5 2) ; 5^2
;; now i want to parse snafu number, right?
;; reverse, start with power 0 yeah, i guess
;; 1-12
(mul-to-char 1)
(mul-to-char -1)
(mul-to-char -2)
(char-to-mul #\=)
(coerce )
(let ((str "1-12"))
(loop
for char across (reverse (coerce str 'array))
for pow from 0
collect (cons pow (char-to-mul char))))
(snafu-to-dec (read-snafu "1-12"))
;; but last thing i want is decimal to snafu.
;; and that's ugh.
;; i could decode into 5 base system, maybe even automatically,
;; then parse into powers of 5 written in 0 - 5
(format t "print in base/radix 5 - ~5R ~5R ~5R ~5R ~5R " 4 5 6 7 8 9)
;; i think this works.
;; now i could parse this into amounts of powers of 5.
;; but then i'd still need to go from 0..5 to -2..2
;;
;; if in pow_k we have >2
;; we can +1 to higher power pow_k+1
;; and to balance -5 in pow_k
(decimal-to-pows-5 1747) ; yeah, maybe good, yes
(- (char-code #\1) (char-code #\0))
(- (char-code #\4) (char-code #\0))
(- (char-code #\6) (char-code #\0))
(- (char-code #\7) (char-code #\0))
(- (char-code #\9) (char-code #\0))
;; and now - modify multipliers of the powers.
;; loop from 0 to (1- length) over all powers.
;;
(defparameter *test-snafu*
'((5 . 1) (4 . -2) (3 . -1) (2 . 0) (1 . -1) (0 . 2)))
(setf (cdr (assoc 4 *test-snafu*)) 6)
(setf (cdr (assoc 6 *test-snafu*)) 6)
(setf (assoc 6 *test-snafu*) '(6 . 2))
(alexandria:assoc-value *test-snafu* 4)
(print (decimal-to-pows-5 1747))
;; ((0 . 2) (1 . 4) (2 . 4) (3 . 3) (4 . 2))
(print (pows-5-to-snafu (decimal-to-pows-5 1747)))
;; ((0 . 2) (1 . -1) (2 . 0) (3 . -1) (4 . -2) (5 . 1))
;; ((0 . 2) (1 . 4) (2 . 4) (3 . 3) (4 . 2))
;; ((0 . -3) (1 . 0) (2 . 5) (3 . 3) (4 . 2))
(coerce (list #\a #\1 #\- #\e) 'string)
(snafu-to-dec (pows-5-to-snafu (decimal-to-pows-5 1747)))
(snafu-pows-print (pows-5-to-snafu (decimal-to-pows-5 1747)))
;; yeah
(loop
for line in (uiop:read-file-lines "day25-test.txt")
for dec = (snafu-to-dec (read-snafu line))
summing dec into the-sum
finally (return (snafu-pows-print (decimal-to-snafu the-sum))))
;; (part-1-calc "day25-test.txt")
;; (print (part-1-calc "day25-input.txt"))

13
day25-test.txt Normal file
View File

@@ -0,0 +1,13 @@
1=-0-2
12111
2=0=
21
2=01
111
20012
112
1=-1=
1-12
12
1=
122

68
day25.lisp Normal file
View File

@@ -0,0 +1,68 @@
;; https://adventofcode.com/2022/day/25
(defpackage :day-25
(:use :cl))
(in-package :day-25)
(ql:quickload 'alexandria)
(defun snafu-to-dec (snafu-alist)
(loop
for (pow . mul) in snafu-alist
sum (* mul (expt 5 pow))))
;; let's do that as alist as well?
(defparameter *snafu-char-to-mul*
'((#\2 . 2)
(#\1 . 1)
(#\0 . 0)
(#\- . -1)
(#\= . -2)))
(defun char-to-mul (char)
(alexandria:assoc-value *snafu-char-to-mul* char))
(defun mul-to-char (n)
(alexandria:rassoc-value *snafu-char-to-mul* n))
;; into the alist power representation
(defun read-snafu (str)
(loop
for char across (reverse (coerce str 'array))
for pow from 0
collect (cons pow (char-to-mul char))))
(defun decimal-to-pows-5 (num)
(let ((str (format nil "~5R" num)))
(loop
for char across (reverse (coerce str 'array))
for pow from 0
;; do (print char)
collect (cons pow (- (char-code char) (char-code #\0))))))
(defun pows-5-to-snafu (pows-5)
(let ((copied-list (copy-alist pows-5)))
(loop
for pow from 0 below (length pows-5)
when (> (alexandria:assoc-value copied-list pow) 2)
do (progn
(incf (cdr (assoc pow copied-list)) -5)
(when (not (assoc (1+ pow) copied-list))
(push (cons (1+ pow) 0) copied-list))
(incf (cdr (assoc (1+ pow) copied-list)))))
copied-list))
(defun snafu-pows-print (snafu-alist)
(coerce (loop
for pow from (1- (length snafu-alist)) downto 0
collect (mul-to-char (alexandria:assoc-value snafu-alist pow))
)
'string))
(defun decimal-to-snafu (num)
(pows-5-to-snafu (decimal-to-pows-5 num)))
(defun part-1-calc (filename)
(loop
for line in (uiop:read-file-lines filename)
for dec = (snafu-to-dec (read-snafu line))
summing dec into the-sum
finally (return (snafu-pows-print (decimal-to-snafu the-sum)))) )