Anger/AoC

From J Wiki
Jump to navigation Jump to search

Introduction

[Advent Of Code] is an annual set of Christmas-themed computer programming problems devised by Eric Wastl. Here are some responses to the first series of problems, posted in December 2015, one pair of problems per day.

Registered contestants were sent specific inputs, plus a follow-on problem for further skill testing. Their solutions were tested, and successful solvers were posted and ranked by time to solution.

These problems are suitable for all levels of programming experience. Solutions are posted here to demonstrate J's value as a general-purpose programming language.

Problem 1 (Count Parentheses)

Statement at Advent of Code: Not Quite Lisp
Input is a file containing randomly chosen parenthesis characters starting with "(". "(" means "go up a floor", ")" means "descend 1 floor".

Part 1
Contribution from David Lambert:
On what floor does Santa finish? Start at 0.

read=:  1!:1@boxopen
mp=:    +/ .*
PART1=: +/ 1 _1 mp '()'=/read'input'

Part 2
Contribution from David Lambert:
When does Santa first enter the basement?

PART2=: >: _1 i.~ +/\ 1 _1 mp '()'=/read'input'

Problem 2 (Wrapping Paper)

Statement at Advent of Code: I Was Told There Would Be No Math
Contribution from David Lambert:
Input is a file of rectangular-package dimensions, such as:

4x23x21
22x29x19

Part 1
Contribution from David Lambert:

read=: 1!:1@:boxopen

SIZES=: |: _3 [\ _".(e.&(CR,LF,'x'))`(,:&' ')}read'input'
NB. Observe that SIZES is the transposed matrix so that
NB.  items are lengths, widths, and heights.

Note '(2 */\ (, {.))'
 (, {.)'LWH'  is   'LWHL'
 into which we insert multiply in length-2 infixes,
 producing the areas LW, WH, and HL.
)

Note '(+: , <./)'
 Double the areas and concatenate the smallest.
)

PART1=: +/ , (+: , <./) (2 */\ (, {.)) SIZES

Part 2
Contribution from David Lambert:
With SIZES as the 3 by-package tally array from Part 1, we have this crazy formula for ribbon length. For minimal circumference, I've summed length+height+width and subtracted the (per-package) minimum.

volume=:        */
circumference=: +:@:(+/ - >./)
PART2=:         ([: +/ [: , (volume + circumference)) SIZES

Problem 3 (Package Delivery)

Statement at Advent of Code: Perfectly Spherical Houses in a Vacuum
Here the input file contains a sequence of characters randomly chosen from <>v^ . Each character indicates to move one cell in its pointing direction. How many homes on a 2-D grid receive at least one visit?

Comment from [Alex Shroyer]:

   NB. Complex-number review:  successive multiplications give right-, up-, left-, down-increments,
   NB.  corresponding to 0 degrees, 90 degrees, 180 degrees, 270 degrees.
   NB.  (North is to the right and the compass is right-handed, if your mental picture is geocentric.)
   0j1(^i.)4
1 0j1 _1 0j_1

Part 1
Contribution from David Lambert:
The tour verb consists of two pieces. The right-hand side of at (@:) converts the input to a vector of increments concatenated to the starting location. On the left-hand side a verb is inserted. This verb takes as x the increment, and as y the vector of places visited. Tail of y is the current location. Result of this verb is the path traversed (all of y) with the new location appended. J does all this work from right to left, needing the reversal (|.). Starting location and traversal direction shouldn't affect the solution. With the locations known, we need just the tally of the nub.

read=:  1!:1@:boxopen
ROUTE=: |. read 'input'
tour=:  (] , (+ {:))/@:(0 ,~  ((0j1(^i.)4) {~ '>^<v'&i.))
PART1=: # ~. tour ROUTE

Part 2
Contribution from David Lambert:
This puzzle splits the deliveries between two Santas. Apply tour to each group, combine the result, and get the tally of the nub of the resulting locations. This solution uses information from Part 1.

PART2=: # ~. ,/ tour"1 |: _2[\ROUTE

We can draw the path. One way is to require'plot' then plot tour ROUTE. We can color the route by history using viewmat. xy separates the complex data to real and imaginary parts, then shifts it from [min,max] to [0,max-min]. xy@:visits creates a matrix of grid coordinates--x in column 0, y in column 1. This list is input to this expression: ((>:@:i.@:#@:[)`(<"1@:[)`(])} (0 $~ >:@:(>./))) which is a hook. (dyad monad) y evaluates as y dyad monad y . The dyad in the hook is dyadic amend values`indexes`array} , which operates on the array of zeros given by (0 $~ >:@:(>./)) . We increment the shape so that the maximum index values are bounded. (If the tally is n, then the valid non-negative indexes are on [0, n-1]).

NB. Drawing the "drunken walk"
require 'viewmat'
xy=: (-"1 <./)@:+.
viewmat@:((>:@:i.@:#@:[)`(<"1@:[)`(])} (0 $~ >:@:(>./)))@:xy@:visits ROUTE

Problem 4 (MD5)

Statement at Advent of Code: The Ideal Stocking Stuffer
Message-Digest encryption

Contribution from Moon S.:
Given a key, say 'abcdef', append incremental numbers until the md5 hash starts with 5 zeros. In Part 2, the hash starts with 6 zeros. Unfortunately, the md5 addon does not work universally. The 64-bit repair is as follows:

NB. load'~addons/convert/misc/md5.ijs'

NB. convert/misc/md5
NB. RSA Data Security, Inc. MD5 Message-Digest Algorithm
NB. version: 1.0.2
NB.
NB. See RFC 1321 for license details
NB. J implementation -- (C) 2003 Oleg Kobchenko;
NB. 09/04/2003 Oleg Kobchenko
NB. 03/31/2007 Oleg Kobchenko j601, JAL
NB. 12/17/2015 G.Pruss j803-64

coclass 'pcrypt'

NB. lt= (*. -.)~   gt= *. -.   ge= +. -.   xor= ~:
'`lt gt ge xor and or sh'=: (20 b.)`(18 b.)`(27 b.)`(22 b.)`(17 b.)`(23 b.)`(33 b.)
rot=:     16bffffffff and sh or ] sh~ 32 -~ [ NB. (y << x) | (y >>> (32 - x))
add=:     ((16bffffffff&and)@+)"0
hexlist=: tolower@:,@:hfd@:,@:(|."1)@(256 256 256 256&#:)

cmn=: 4 : 0
  'x s t'=. x [ 'q a b'=. y
  b add s rot (a add q) add (x add t)
)

ff=: cmn (((1&{ and 2&{) or 1&{ lt 3&{) , 2&{.)
gg=: cmn (((1&{ and 3&{) or 2&{ gt 3&{) , 2&{.)
hh=: cmn (((1&{ xor 2&{)xor 3&{       ) , 2&{.)
ii=: cmn (( 2&{ xor 1&{  ge 3&{       ) , 2&{.)
op=: ff`gg`hh`ii

I=: ".;._2(0 : 0)
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
1 6 11 0 5 10 15 4 9 14 3 8 13 2 7 12
5 8 11 14 1 4 7 10 13 0 3 6 9 12 15 2
0 7 14 5 12 3 10 1 8 15 6 13 4 11 2 9
)
S=: 4 4$7 12 17 22 5 9 14 20 4 11 16 23 6 10 15 21
T=: 4 16$<.16b100000000*|1 o.>:i.64   NB. Constants cache generated by sine

norm=: 3 : 0
  n=. 16 * 1 + _6 sh 8 + #y
  b=. n#0  [  y=. a.i.y
  for_i. i. #y do.
    b=. ((j { b) or (8*4|i) sh i{y) (j=. _2 sh i) } b
  end.
  b=. ((j { b) or (8*4|i) sh 128) (j=._2 sh i=.#y) } b
  _16]\ (8 * #y) (n-2) } b
)

NB.*md5 v MD5 Message-Digest Algorithm
NB.  digest=. md5 message
md5=: 3 : 0
X=. norm y
q=. r=. 16b67452301 16befcdab89 16b98badcfe 16b10325476
for_x. X do.
  for_j. i.4 do.
    l=. ((j{I){x) ,. (16$j{S) ,. j{T
    for_i. i.16 do.
      r=. _1|.((i{l) (op@.j) r),}.r
    end.
  end.
  q=. r=. r add q
end.
hexlist r
)

md5_z_=: md5_pcrypt_

NB. standard tests
assert 'd41d8cd98f00b204e9800998ecf8427e' -: md5 ''
assert '7215ee9c7d9dc229d2921a40e899ec5f' -: md5 ' '
assert '0cc175b9c0f1b6a831c399e269772661' -: md5 'a'
assert '900150983cd24fb0d6963f7d28e17f72' -: md5 'abc'
assert 'f96b697d7cb7938d525a2f31aaf161d0' -: md5 'message digest'
assert 'c3fcd3d76192e4007dfb496cca67e13b' -: md5 a=.'abcdefghijklmnopqrstuvwxyz'
assert 'd174ab98d277d9f5a5611c2c9f419d9f' -: md5 'ABCDEFGHIJKLMNOPQRSTUVWXYZ',a,'0123456789'
assert '57edf4a22be3c955ac49da2e2107b67a' -: md5 80$'1234567890'

With this code, we continue to Part 1. The hooked sentence (copy~ selection"_1)DATA is often useful.

Part 1
Contribution from David Lambert:
Assume the solution is in the first million. This succeeds, but is dreadfully slow. A compiled version of the md5 algorithm helps.

   key=: 'yzbqklnj'
   A=:   (key,":)&.>;/i.1000000                                                                                                                                                  
   $A
1000000

   4{.A
┌─────────┬─────────┬─────────┬─────────┐
│yzbqklnj0│yzbqklnj1│yzbqklnj2│yzbqklnj3│
└─────────┴─────────┴─────────┴─────────┘

   B=: md5&>A

   (#~ ('00000' (-:"1) _ 5&{.))B
000002c655df7738246e88f6c1c43eb7
000009a91d3753055962a4758e9bca48
   
   (i. (#~ ('00000' (-:"1) _ 5&{.)))B
282749 384166

Part 2
= Contribution from David Lambert:
And, not to be a language despot, a python solution is:

from hashlib import md5
key = b'yzbqklnj'
i = 0
while True:
    a = md5(key+'{}'.format(i).encode('utf8')).hexdigest()
    if a.startswith('0'*5):
        print(a, i)
    if a.startswith('0'*6):
        break
    i += 1

Problem 5 (Find Nice Strings)

Statement at Advent of Code: Doesn't He Have Intern-Elves For This?

Part 1
Contribution from David Lambert:

read=: 1!:1@:boxopen

STRINGS=: [;._2 ,&LF^:(LF~:{:) read'input'

NB. Part 1
enough_vowels=:  2 < ([: +/ e.&'aeiou')"1
letter_repeats=: 1 e. (=|.!.' ')
bad_words=:      1 e. [: , (_2[\'abcdpqxy')&(E."1/)
nice =:          (1 1 0 -: enough_vowels,letter_repeats,bad_words)"1
PART1=:          +/ nice STRINGS

Contribution from Henry Rich:
|.!. customized shift reminded to us.

Part 2
Contribution from Henry Rich:

NB. Read in the strings from the clipboard
i =. ];._2 wd 'clippaste'
NB. Direct implementation: Find all 2-atom infixes; examine (location of each)-(first occurrence of same value):
NB. a result > 1 means a repeated infix.  Also, go through 3-item infixes, see which ones have first
NB. letter = last.  Apply to each string.
+/ ([: +./ 3&(=/@:(0 _1&{)\)) *. (1 < >./@(i.@# - i.~)@(2&(]\)))"1 i

Problem 6 (Lighting Control)

Statement at Advent of Code: Probably a Fire Hazard

Part 1
Contribution from Henry Rich:

NB. Convert the action script into a J script.
NB. First, make each line an assignment statement and enclose block sizes in parentheses
i =. <@('y =. y ' , ;@(<@('(' , ,&')');._2)@:(,&' '));._2 wd 'clippaste'
NB. Define the verbs--
NB. through: to create a 1000x1000 block with 1s in the active positions
through =: (1000 1000 {. ({. ($&1)))/@(-~/\)@:-@(,:~ >:)
NB. turn: NOP
turn =: 1 : 'u'
NB. on/off/toggle - to combine the result of through with the previous state
'`off on toggle' =: >`+.`~:
NB. Treat the input as a single verb to be executed
+/@, 3 : i 1000 1000 $ 0

Part 2
Contribution from Henry Rich:

NB. Same idea, with different definition of off/on/toggle
'`off on toggle' =: (0 >. -)`+`(+ +:) 
+/@, 3 : i 1000 1000 $ 0

Problem 7 (Wiring Simulation)

Statement at Advent of Code: Some Assembly Required

Part 1
Contribution from Henry Rich:

LC =: 'abcdefghijklmnopqrstuvwxyz'
'`NOT OR AND LSHIFT RSHIFT' =: (65535&-)`(23 b.)`(17 b.)`(65535 (17 b.) (33 b.)~)`(33 b.~ -)
NB. Read input, convert to words.  There seems to be an extra LF
NB. Extract signal-names (which start with lowercase), giving list of boxed names, where the last name
NB.  is the output and the preceding are the inputs that produced it
Nm =: (#~ e.&LC@{.@>)&.> I =: a: -.~ <@;:;._2 wd 'clippaste'
NB. Perform topological sort on names.  Result is the list of names in the order
NB.  they need to be evaluated.  The implementation is recursive: find names that need no inputs;
NB.  make them the first results; recur on all the rest; join the first results with the result of the
NB.  recursion.
Toponm =: ((;@#~ ([ , $:@(-.L:1~)^:(*.&*&#)) (#~ -.)) 1&>:@#@>) Nm
NB. Sort lines by result-name, convert to executable J assignments, execute
([: ".@(;:^:_1) {: , '=:' ; _3&}.)@> I /: Toponm i. {:@> I
NB. Result?
a

Part 2
Contribution from David Lambert:
Part 2 has the same solution as Part 1 but solved with a new input signal on wire "b". This solution uses the name space of a locale to track the known names from which a new sentence may be completed. The input is stored in a file named input. Completed sentences are removed from the list of sentences needing completion. x and y are capitalized to avoid name conflict in the explicit verb.

read=: 1!:1@:boxopen
SENTENCES=: (_1&{::,'=:',[:;:inv}:)@:;:;._1 LF,('xy'&i.)`([:|:'XY',"1 0[)} '->'-.~read'input'

f=: 3 :0
 AND=:    2b10001 b.
 OR=:     2b10111 b.
 BITS16=: 16bffff
 LSHIFT=: BITS16 AND (33 b.)~
 RSHIFT=: LSHIFT -
 NOT=:    BITS16&(2b10110 b.)
 while. ([smoutput)#y do.
  if. (0 = [: # ([: ". {.) :: (''"_)) y do.
   y =. 1 |. y
  else.
   smoutput {.y
   y =. }. y
  end.
 end.
 a
)

L=: 18!:3''
topological_eval__L=: f f.

PART1=: topological_eval__L SENTENCES

M=: 18!:3''
topological_eval__M=: f f.

PART2=: PART1 ([: topological_eval__M ({:@:$@:]{.'b=:',[:":[)`([:I.'b=:'(-:"1)_ 3{.])`]})SENTENCES

Problem 8 (Counting Escaped Characters)

Statement at Advent of Code: Matchsticks

Part 1
Contribution from Henry Rich:

NB. Read in the data from the clipboard, one box per line, with blank lines removed
i =. a: -.~ <;._2 wd 'clippaste'
NB. On the left, find mask of \x sequences; on the right, the mask of unescaped \
NB. Add up: 2 (for " chars) + 2 * number of unescaped \x, plus number of unescaped \
+/ ('\x'&E. (2 + (2 * +/@:*.) + +/@]) >/\.&.|.@('\'&=))@> i

Contribution from David Lambert:
Using sequential machine, with file 'input' containing the list:

read=: 1!:1@:boxopen
mp=: +/ .*

M=: (>:@:i.@:# mp a.&e.&>)(Num_j_,6{.26}.Alpha_j_);(;/'"\x')

Note 'the sequential machine'
 Puzzle solution is the count of boxes.
 Each box contains an item for later count.
 [0] start.
 [1] error condition.   Use 1j3 to enter this state.
 [2] escape \ found
 [3] \xD
 [4] \xDD
 [5] unescaped "
)

S=:  +. ". }. [;._2 noun define
     boring  hex     "       \       x       
[0]  0j0     0j0     5j1     2j1     0j0     NB. normal
[1]  1j6     1j6     1j6     1j6     1j6     NB. error
[2]  1j3     1j3     0j3     0j3     3j0     NB. start of \ sequence
[3]  1j3     4j0     1j3     1j3     1j3     NB. \xH
[4]  1j3     0j3     1j3     1j3     1j3     NB. \xHH
[5]  0j3     0j3     5j2     2j2     0j3     NB. "
)

PART1=: #;(0;S;M);:read'input'

Part 2
Contribution from Henry Rich:

NB. For each line: 2 for outer quotes, plus one for each character that must be escaped
+/ (2 + +/@(e.&'"\'))@> i

Problem 9 (Traveling Salesman)

Statement at Advent of Code: All in a Single Night

Part 1
Contribution from Henry Rich:

NB. Read in data, convert to array
i =: (+ |:) 0 ,~ 0 ,. |."1 |.@:((0&".)@>)/./ |: (0 _1&{)@;:;._2 }: wd 'clippaste'
NB. Find shortest path by enumerating all possibilities
<./ (i.@! ([: +/ i (<"1@[ { ])~ 2 ]\ A.)"0 _ i.) #i

Part 2
Contribution from Henry Rich:

NB. Same, but find longest path
>./ (i.@! ([: +/ i (<"1@[ { ])~ 2 ]\ A.)"0 _ i.) #i

Problem 10 (Look And Say)

Statement at Advent of Code: Elves Look, Elves Say

Part 1
Contribution from Henry Rich:

NB. The personal input
i =. '1113122113'
NB. Convert to integer; create mask where new value begins;
NB. Create (count,value) for each run of values;
NB. Run them together to end turn.  Take 40 turns, get size of result
# ,@((# , {.);.1~ (~: |.!.0))^:40 "."0 i

Part 2
Like Part 1, but change the 40 to 50.

Problem 11 (Password Update)

Statement at Advent of Code: Corporate Policy

Part 1
Contribution from Henry Rich:
A good solution should be cleverer than simply incrementing through all possibilities, lest the input have a high-order 'o', 'i', or 'l' that would require many cycles.

LC =: 'abcdefghijklmnopqrstuvwxyz'
i =: wd 'clippaste'
NB. Define the 3 conditions
hasoil =: (+./@:e.)&(LC i. 'oil')  NB. no o i l
straight =: [: +./ 3 (}:-:}.)\ (- (i.@#))
twopair =: 1 < 1 (i: - i.)~ 2 =/\ ]
NB. Increment, but skip over disallowed values
inc =: ]&.((8#26)&#.) @: (+    [: 1&((_1)})^:(0 = *./) (e.&(LC i. 'oil')))
smoutput npw =. inc^:(hasoil +. straight *: twopair)^:_@inc &.(LC&i.) i

On account of a bug in E., I used C, patterned after what would have been the J program. This code uses the trick noted in the introduction.

/*
  Let this be the file c.c .
  adventofcode.com/day/2015/day/11, tests and solution given by linux command:
  a=./c && make $a && $a hijklmmn abbceffg abbcegjk abcdefgh abcdffaa ghijklmn ghjaabcc cqjxjnds
*/

#include<stdio.h>
#include<stdlib.h>

typedef unsigned char V[8];

/*
  return the index of the first character oil, or -1 if not present
*/
int lionize(V v) {
  int i;
  for (i = 0; i < 8; ++i)
    if ((('o'-'a') == v[i]) || (('i'-'a') == v[i]) || (('l'-'a') == v[i]))
      return i;
  return -1;
}

/*
  Passwords must include one increasing straight of at least three letters,
  like abc, bcd, cde, and so on, up to xyz. They cannot skip letters;
  abd doesn\'t count;
  return true iff the string has a straight.
*/
int straight(V v) {
  int i;
  for (i = 1; i < 7; ++i)
    if ((v[i+2] == v[i]+2) && (v[i+1] == v[i]+1))
      return 1;
  return 0;
}

/*
  Passwords may not contain the letters i, o, or l,
  as these letters can be mistaken for other characters and are therefore confusing;
  return 1 if the string does not contain oil.
*/
int lion(V v) {
  return lionize(v) == -1;
}

/*
  Passwords must contain at least two pairs of repeated letters, like aa, bb, or zz.
  Return 1 iff the string meets this spec.
*/
int pairs(V v) {
  int i, j = 0;
  for (i = 0; i < 5; ++i)
    if (v[i] == v[i+1]) {
      j = 1;
      break;
    }
  if (!j)
    return 0;
  for (i += 2; i < 7; ++i)
    if (v[i] == v[i+1])
      return 1;
  return 0;
}

/*
  return true iff string ok
*/
int valid(V v) {
  return lion(v) && straight(v) && pairs(v);
}

void inc(V v) {
  int i, field = lionize(v);
  if (field < 0)
    field = 7;
  ++v[field];
  for (i = field + 1; i < 8; ++i)
    v[i] = 0;
  for (i = field; 0 < i; --i)
    if (25 < v[i])
      v[i] = 0, ++v[i-1];
  if (25 < v[i])
    v[i] = 0;
}

void a2v(char*pc, V v) {
  int i;
  for (i = 0; *pc && (i < 8); ++i)
    v[i] = *pc++ - 'a';
  for (; i < 8; ++i)
    v[i] = 0;
}

void v2a(V v, char pc[8]) {
  int i;
  for (i = 0; i < 8; ++i)
    pc[i] = v[i] + 'a';
}

void next(V v) {
  while (! valid(v))
    inc(v);
}

/*
  display several passwords starting at the program argument.
  use: $ a.out cqjxjnds
*/
int main(int ac,char*av[]) {
  int i;
  char a[8];
  V v;
  while (++av , --ac) {
    a2v(*av, v);
    printf("%s %d ", *av, valid(v));
    for (i = 0; i < 7; ++i)
      inc(v), next(v), v2a(v, a), printf(" %.8s",a);
    putchar('\n');
  }
  return 0;
}

Part 2
Contribution from Henry Rich:

smoutput inc^:(hasoil +. straight *: twopair)^:_@inc &.(LC&i.) npw

Problem 12 (JSON Parsing)

Statement at Advent of Code: JSAbacusFramework.io

Part 1
Contribution from Henry Rich:

NB. Read input, convert to J words
i =: <@;:;._2 iraw =. wd 'clippaste'
NB. Discard words that don't start with numeric or '-'; then convert each set of words
NB.  ending with a numeric, which joins the '-' to the value; then sum the results
+/ (0&".@;;.2~ ~:&(<,'-')) (#~ '-0123456789' e.~ {.@>) ;i

Part 2
Contribution from Henry Rich:

NB. Find the (start,end) of {} enclosing the location of each :"red"
NB. Convert start,end to start,end+1 for each block
redblocks =: 0 1 +"1 (I. ':"red"' E. iraw) mep iraw;'{}'
NB. Discard red strings that are included in other red strings
NB. Sort strings into order of start, and discard ones that end before some
NB.  previous string
culledred =: (#~   {."1 >: |.!.0@:(>./\)@:({:"1)) /:~ redblocks
NB. Discard the red strings from the input
culledi =: (_2 ,.@:(-~/\)\ 0 , (,culledred) , #iraw) ;@:(<;.0) iraw
NB. Calculate the requested result, as for part 1
+/ (0&".@;;.2~ ~:&(<,'-')) (#~ '-0123456789' e.~ {.@>) ;: culledi

This program uses the verb 'mep' defined at: Essays/Parentheses Matching.

Problem 13 (Cyclic Permutations)

Statement at Advent of Code: Knights of the Dinner Table

Part 1
Contribution from Henry Rich:

NB. Read in data, keeping names & happiness
nms =: ~. {."1 nngv =: (0 _1 2 3&{)@;:;._2 '.' -.~ wd 'clippaste'
NB. Extract happiness
vals =: (-@]^:('l'={.@[)  0&".)&>/"1 (_2) {."1 nngv
NB. Create array of affinities.  Make it symmetric
i =: (+ |:) vals (<"1 nms i. 2 {."1 nngv)} (2##nms) $ 0
NB. Enumerate all possible orders, add up the affinities for each, take largest
maxhap =: >./ (i.@! ([: +/ i (<"1@[ { ])~ [: (,. 1&|.) A.)"0 _ i.) #i

Part 2
Contribution from Henry Rich:

NB. Adding a dummy is equivalent to not closing the ring
maxhap2 =: >./ (i.@! ([: +/ i (<"1@[ { ])~ 2 ]\ A.)"0 _ i.) #i

Problem 14 (Reindeer Speed])

Statement at Advent of Code: Reindeer Olympics

Part 1
Contribution from Henry Rich:

NB. Read in data, convert to numeric.  Result is table where
NB.  each row has (speed), (flying time), (resting time)
sfr =: 0&".@> sfr (3 8 16&{)@;:;._2 wd 'clippaste'
NB. Calculate distances.  Convert each fly,rest to (#full cycles),(remainder)
NB. Then clamp the remainder to the flying time, convert to time flown;
NB.  then multiply by speed.
>./ (0&{ * (_,1&{) ([ #. <.) 2503 #:~ (0,+/@(1 2&{)))"1 sfr

Part 2
Contribution from Henry Rich:

NB. Totally rewritten. Create table of distance flown for each time-interval;
NB.  create running total; assign points to winners for each interval; add and
NB.  take the largest
>./ +/"1 (="1 >./) +/\"1 (2503 $ *`(1 0 #~ ,)/)"1 sfr

Problem 15 (Cookie Recipes)

Statement at Advent of Code: Science for Hungry People

Part 1
Contribution from Henry Rich:
For the first problem I was worried that the search space was too large for an exhaustive search, so I implemented a greedy algorithm to look for a local maximum. The algorithm starts with the best point from a number of random ones, and then searches a region around the local maximum to see if improvement is possible. As it turned out, the final search was not required.

NB. Read in data, convert to numeric.  Remove multiple LFs
i =: <@;:;._2 iraw =: ((#~ -.) (LF,LF)&E.) wd 'clippaste'
ing =: |: }:"1 nums =: (0&".@;;.2~ ~:&(<,'-'))@(#~ '-0123456789' e.~ {.@>)@> i

NB. Part 1.  Discrete optimization.
NB. Score a combination.  x is matrix, y is combination
NB. Illegal combinations (first calculation) get negative score
score =: ((0 > <./@]) _1:^:[ [: */ 0 >. +/ . *)"2 1

NB.  List of possible moves to neighboring point, plus a first line for 'no move'
neighbors =: 0 , (#~  (0 = +/"1) *. (2 = +/@:|"1)) _1 0 1 {~"1 (#: i.@:(*/)) 3 3 3 3

NB. Moves in a region around a point.
NB. The first line is the 0 line, for stability when we are at the maximum
nregion =: (#~  (0 = +/"1)) 0 5 _5 4 _4 3 _3 2 _2 1 _1 {~"1 (#: i.@:(*/)) 11 11 11 11

NB. Get max score on matrix y.  Verb u is the scoring verb.
NB. Not guaranteed.  Uses greedy algorithm plus search
maxscore =: 1 : 0
NB. Deal random feasible starting points, get highest score
startpt =: ({~ (i. >./)@:(y&u)) (,.   100 - +/"1) 1000 3 ?@$ 33
assert. 0 < y u startpt

whilst. greedybest -.@-: startpt do.
  NB. Greedy algorithm to find largest score
  greedybest =: ({~ (i. >./)@:(y&u))@:(neighbors&(+"1))^:_ startpt

  NB. Search in the region around the maximum to see if score can be improved
  startpt =: ({~ (i. >./)@:(y&u))@:(nregion&(+"1)) greedybest
end.
y u startpt
)
score maxscore ing

Part 2
Contribution from Henry Rich:
The method of Part 1 is not applicable because the feasible solutions are sparse, but I realized that the search space is not too large for exhaustive search, after all.

NB. Part 2.  Total rewrite.  Enumerate all possible partitions,
NB.  find ones with correct calories, choose largest score
allparts =: 2 -~/\"1 (0) ,. 100 ,.~ (#~ (*./@:>: |.!.0)"1) (#: i.@:(*/)) 101 101 101
NB. Cull to correct calories
cal500 =: (#~  500 = ({:"1 nums) +/@:*"1 ]) allparts
NB. Find best score
>./ ing score cal500

Problem 16 (Database Search)

Statement at Advent of Code: Aunt Sue

Part 1
Contribution from Henry Rich:

NB. Read the search data: take lines; convert to words; convert numeric to numbers
clue =: ([^:(__ e. ]) __&".)&.>@;:;._2 wd 'clippaste'
NB. Extract names and values
names =: {."1 clue
clueval =: 1 {::"1 clue
NB. Get list of boxes for each aunt, each containing a list of att:value
db =: <@:(2&}.)@(([^:(__ e. ]) __&".)&.>@;:);._2 ',' -.~ (#~ [: -. (LF,LF)&E.) wd'clippaste'
NB. Create list of values for each aunt, using _ for missing values
dbflat =: (names (1&{::"1@])`(i. {."1)`(_"0@[)} _2&(]\))@> db
NB. Find lines that contain at least as much in a given category as was found in the search
I. dbflat ([: *./ (_ ~: [) # =)"1 clueval

<strong> Part 2 </strong><br>
<small>Contribution from [[User:Henry Rich|Henry Rich]]:</small><br>
<pre>
NB. Replace clueval with range, for each value from search
rclueval =: 2 #"0 clueval
NB. Change the datatypes called for in the problem
rcv =: (names i. ;:'cats: trees:') (1 _ +"1 {)`([)`]} rclueval
rcv =: (names i. ;:'pomeranians: goldfish:') (__ _1 +"1 {)`([)`]} rcv
NB. Test for within range
I. dbflat ([: *./ (_ ~: [) # ((>: {.) *. (<: {:))"_1)"1 2 rcv

Problem 17 (Integer Knapsack)

Statement at Advent of Code: No Such Thing as Too Much
This problem could be solved by exhaustive search, but it can be solved quicker as an instance of the Integer Knapsack Problem.

Part 1
Contribution from Henry Rich:

NB. Read in data, convert to list
i =: ".;._2 (#~ (LF,LF) -.@:E. ]) wd 'clippaste'
# solutions =: i iknapsack 150 2

Part 2
Contribution from Henry Rich:

(+/@:= <./) +/"1 solutions

Problem 18 (Game Of Life)

Statement at Advent of Code: Like a GIF For Your Yard

Part 1
Contribution from Henry Rich:

NB. Read in data, convert to Boolean table
i =: '.#'&i.;._2 (#~ (LF,LF) -.@:E. ]) wd 'clippaste'

NB. Game Of Life - one step
NB. The next value, given (value in middle),(total of 9 values in 3x3)
lifeprog =: 2 10 $ 0 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0
NB. Expand board by 1 empty all around, then take next value for each 3x3
life =: (_2 ]\ 1 1 3 3) (lifeprog {~ ([: < (<1 1)&{ , +/@:,));._3 (0)&([ , [ ,~ [ ,. [ ,.~ ])

NB. Run 100 steps
+/@:, life^:100 i

Contribution from David Lambert:
[Not testable on my system] We can animate the frames using:

NB. i =: '.#'&i.;._2 (#~ (LF,LF) -.@:E. ]) wd 'clippaste'  NB. This is the untestable sentence
FRAMES =: life^:(<101) i  NB. Hence, I'm guessing that my frames are your frames.
load 'viewmat'  NB. <- Requires jqt session!
VISIBLE_jviewmat_=:0

(' '&=`(,:&'0')}(":,.i.101))([:viewmat;~)"_1 FRAMES

NB. Using imagemagick animate program, for example, on unix:
NB. pushd ~/j64-804-user/temp
NB. animate ???.png
NB. popd

Part 2
Contribution from Henry Rich:

<cornerson =: 1&((<;~0 _1)})
+/@:, cornerson@life^:100 cornerson i

Problem 19 (String Replacement)

Statement at Advent of Code: Medicine for Rudolph

Part 1
Contribution from Henry Rich:

NB. Read in data, convert to table of (pattern),(replacement)
repls =: ' => '&(taketo ; takeafter);._2 (#~ (LF,LF) -.@:E. ]) wd 'clippaste'
NB. Here is the target molecule
molecule =: 'CRnCaSiRnBSiRnFArTiBPTiTiBFArPBCaSiThSiRnTiBPBPMgArCaSiRnTiMgArCaSiThCaSiRnFArRnSiRnFArTiTiBFArCaCaSiRnSiThCaCaSiRnMgArFYSiRnFYCaFArSiThCaSiThPBPTiMgArCaPRnSiAlArPBCaCaSiRnFYSiThCaRnFArArCaCaSiRnPBSiRnFArMgYCaCaCaCaSiThCaCaSiAlArCaCaSiRnPBSiAlArBCaCaCaCaSiThCaPBSiThPBPBCaSiRnFYFArSiThCaSiRnFArBCaCaSiRnFYFArSiThCaPBSiThCaSiRnPMgArRnFArPTiBCaPRnFArCaCaCaCaSiRnCaCaSiRnFYFArFArBCaSiThFArThSiThSiRnTiRnPMgArFArCaSiThCaPBCaSiRnBFArCaCaPRnCaCaPMgArSiRnFYFArCaSiThRnPBPMgAr'

NB. The only way to get a duplication is for two patterns a => b and c => d to be such
NB.  that ad = bc.  In that case the two replacements will produce the same result and get
NB.  a total one too high.  So we find all the strings ad that qualify.
NB. Subtle point: if a string is replaced by itself, it will count as a 'change' each time;
NB.  but it should count only once.  Since this doesn't seem to happen in the test input, we ignore that case;
NB.  (solution would be to add a pattern '';'' , which would remove ALL the self-replacements,
NB.  and then add 1 if there is any self-replacement)
doublecounts =: a: -.~ , <@((-:&;/)@(,. |.) # ;@,&{.)"1/~ repls
NB. To count single replacements, take the number of replacement points minus the number of duplication points
-/ (({."1 repls) ,&< doublecounts) +/@:((+/@:E.)&>)&> <<molecule

Part 2
Contribution from Henry Rich:
I spent hours thinking about Part 2 before coding anything. Finally I decided that it would be infeasible to try to construct the steps involved in synthesizing the molecule, owing to the amount of backtracking that might be required. Then I noticed the regularity of the production rules. Strictly speaking this program does not find out how many substitutions are needed, but rather how many would be needed if the target is reachable.

NB. Every production increases the length by exactly 1, except for ones producing Rn/Ar, which add 3,
NB.  and those including Y, which add 2 for each Y.  Thus the number of steps is the length of the
NB.  input, minus one for each Ar and Rn, minus 2 for each Y, minus 1 since we start with a single
NB.  symbol.
UC =: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
_1 + (+/@:e.&UC - 'Ar'&(+/@:E.) + 'Rn'&(+/@:E.) + [: +: 'Y'&(+/@:E.)) molecule

Addendum to Part 2
Contribution from Brian Schott:

NB. The main approach for this deconstruction of the given "molecule" 
NB.     (just to see if it could be done)
NB.     was to isolate first all the "xxRn...Ar" strings and work 
NB.     on each in turn. Because those strings are often embedded
NB.     in other "xxRn...Ar" strings, those embeddings had to be
NB.     identified.  
NB. The verb "depth" used here was taken from 
NB.     http://code.jsoftware.com/wiki/Essays/Parentheses_Matching
NB. The "depth" levels are constructed by treating each xxRn...Ar 
NB.     string as if they are parenthesis pairs as suggested by the 
NB.     alignment of the next two lines.
NB.         xxRn....Ar
NB.         xx(n....A)

NB.   Warning, this approach is quite brittle and does not work for all cases, such as 'HOHOHO' in the example.
NB.   However, a "solution" for the 'HOHOHO' example is explored far below.

molecule =: 'CRnCaCaCaSiRnBPTiMgArSiRnSiRnMgArSiRnCaFArTiTiBSiThFYCaFArCaCaSiThCaPBSiThSiThCaCaPTiRnPBSiThRnFArArCaCaSiThCaSiThSiRnMgArCaPTiBPRnFArSiThCaSiRnFArBCaSiRnCaPRnFArPMgYCaFArCaPTiTiTiBPBSiThCaPTiBPBSiRnFArBPBSiRnCaFArBPRnSiRnFArRnSiRnBFArCaFArCaCaCaSiThSiThCaCaPBPTiTiRnFArCaPTiBSiAlArPBCaCaCaCaCaSiRnMgArCaSiThFArThCaSiThCaSiRnCaFYCaSiRnFYFArFArCaSiRnFYFArCaSiRnBPMgArSiThPRnFArCaSiRnFArTiRnSiRnFYFArCaSiRnBFArCaSiRnTiMgArSiThCaSiThCaFArPRnFArSiRnFArTiTiTiTiBCaCaSiRnCaCaFYFArSiThCaPTiBPTiBCaSiThSiRnMgArCaF'

r =: 0 3&{@;: ;._2] 0 : 0
Al => ThF
Al => ThRnFAr
B => BCa
B => TiB
B => TiRnFAr
Ca => CaCa
Ca => PB
Ca => PRnFAr
Ca => SiRnFYFAr
Ca => SiRnMgAr
Ca => SiTh
F => CaF
F => PMg
F => SiAl
H => CRnAlAr
H => CRnFYFYFAr
H => CRnFYMgAr
H => CRnMgYFAr
H => HCa
H => NRnFYFAr
H => NRnMgAr
H => NTh
H => OB
H => ORnFAr
Mg => BF
Mg => TiMg
N => CRnFAr
N => HSi
O => CRnFYFAr
O => CRnMgAr
O => HP
O => NRnFAr
O => OTi
P => CaP
P => PTi
P => SiRnFAr
Si => CaSi
Th => ThCa
Ti => BP
Ti => TiTi
e => HF
e => NAl
e => OMg
)

NB. As an example, imagine that the string "SiRnBPTiMgAr" needs
NB.    to be deconstructed because it has been isolated as part
NB.    of a "depth" analysis.
NB.    "snip" is initially the part between Rn and Ar: BPTiMg
NB.    and  the verb "back" attacks "snip" (backward) from
NB.    right to left, always attempting to find a pattern to
NB.    substitute for the rightmost pair of elements in "snip".
NB.       snip       is BPTiMg  (from y in "back")
NB.       tailofsnip is Mg      (using findtail)
NB.       pretail    is BPTi    (using pretailof)
NB.    Then, using findtail on pretail to get Ti, 
NB.       the list of patterns is i.'d to find TiMg  
NB.       in the if. control. 
NB.    Because Mg=>TiMg is found in r, Mg becomes the tail of
NB.       "snip" and so on.
NB.       snip       is BPMg    (from successful if.)
NB.       tailofsnip is Mg      (using findtail)
NB.       pretail    is BP      (using pretailof)
NB.    If no pattern for TiMg had been found in r in the if., the 
NB.       else. clause would have prepended TiMg to "undone"
NB.       and saved "undone" until the remaining snip was 
NB.       completely reduced. 
NB.    Eventually the processed and reduced "snip" and any "undone"
NB.       is returned to its calling verb, "RnAr" 

UC =:        'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
cod =:       (UC e.~])<;.1  ]        NB. codify element names in y into boxes
num =:       UC +/@e.~ ]             NB. tally element names in y
findtail =:  ] }.~ [: i:&1 UC e.~ ]  NB. finds rightmost element of y
findhead =:  2;@{.cod                NB. finds leftmost  2 elements of y
pretailof =: -@#@[}.]                NB. drops off tail from y (like }:)
rtake =:     ([,' ',])&>/@{&r        NB. get y'th pattern from r

NB.     http://code.jsoftware.com/wiki/Essays/Parentheses_Matching
depth =: [: +/\ =/\@(''''&~:) * 1 _1 0 {~ '()' i. ]
NB. Verbs "lp" and "rp" place ( and ) in the molecule's string for "depth"
lp =:    ('('"_)`( I.@E.)`]}     NB. left parenthesis replaces each R in Rn
rp =:    (')'"_)`( >:@I.@E.)`]}  NB. right parenthesis replaces each r in Ar
decon =. verb define             NB. "decon molecule" to execute this script *******
max =.   >./depth'Ar' rp 'Rn' lp y
max decon y
:
Count =: 0     NB. Count is the only global noun
level =. x
whole =. y
max =.   >./depth'Ar' rp 'Rn' lp y
assert. level <: max
NB. level 0 is treated differently from levels>0
while. level> 0 do.
   NB. while the current depth (ie, state) is >: level
   while.  level <: state =. >./depth'Ar' rp 'Rn' lp whole  do.
      whole =. state process whole   NB. this line calls the verb "process"
      smoutput (1&":@([:depth'Ar' rp 'Rn' lp]);&(_25]\])])whole
   end.
   level=.level-1
end.    
back whole,' _2'     NB. this is level 0
Count
)

NB. deconstruct levels > 0
process =: dyad define
level =. x
whole =. y
ffind =. level find whole
smoutput 'position: ',p =. ":-~/}:ffind
main =.  whole{~(([+i.@])/)}.ffind
t =.     ((-{.ffind){.(1{ffind){. whole) 
smoutput 'process: ',(":level),' ',t,main 
NB. right arg of "RnAr" is a space delimited pair of strings
NB.   first string is the elements to be deconstructed,
NB.   second string is start position
new =.    ({.~i.&' ')t RnAr ;:(_2}.2}.main),' ',p
rot =.    (-~/}:ffind)&|.
drop =.   (#t,main)&}.
append =. new&,
(append&drop)&.rot whole
)

NB. called by "process" for each xxRn..Ar snippet
RnAr =: dyad define
xx =. x  NB. xx in xxRn..Ar (1 or 2 letters)
'snip position' =. y
'reduce position' =. ;:back snip,' ',":(".position)+#xx
p =. ". position
o =. #xx
t =. ({:|:r) i. < xx,'Rn',reduce,'Ar'
smoutput 'subst: ',(rtake t),' ',": p-o
Count =: Count + 1
(>t{{.|:r),' ',>:&.".":p+o+2
)

NB. called by "RnAr" to deconstruct elements between Rn and Ar
back =. monad define
undone =.         i. 0
'snip position'=. ;:y
p =.              ". position
count =.          0
while. #snip,undone do.
   snip =.   snip,undone
   undone =. i. 0
   while. snip >&num tailofsnip=. findtail snip do.
      pretail =. tailofsnip pretailof snip
      NB. determine if the 2 rightmost elements can be substitued for
      NB.     by comparing the result of i. with the tally of r
      NB. if so, make the substitution, otherwise prepend the 2 
      NB.     elements to the list "undone" 
      if. (#r)>t =. ({:|:r) i. (<(s=.tailofsnip),~findtail pretail) do.
         snip =.  (snip}.~-#s,findtail pretail), >t{{.|:r
         smoutput 'subst: ',(rtake t),' ',":p+2+(-count+2+#undone)#@;@}. cod >{.;:y
         count =. count + 1
      else.
         smoutput 'undone: ',undone =. undone,~u=.tailofsnip,~findtail pretail
         snip =.  snip}.~-#u 
      end.
   end.
   break.
end.
Count =: Count + count
snip,undone,' ',position
)

NB. finds first left paren at level x in y
NB. resulting triple of integers is 
NB.    the number of characters before the Rn,
NB.    the starting index in y of the R,
NB.    the length of the string Rn...Ar in y 
find =: dyad define
level =.  x
whole =.  y
ind =.    ([:depth'Ar' rp 'Rn' lp]) whole
start =.  level i.~ ind
length =. >: 1 i.~ level~:start}.ind
pr =.     # findtail start{.whole
pr,start,length
)

NB. At level 0 in "depth", no "xxRn...Ar" strings remain and a 
NB.    different direction of parsing seemed to work, so instead 
NB.    of the strategy of using the verbs "RnAr" and "back", which
NB.    are used for higher levels, only the verb "back" 
NB.    was used for level 0.

Note 'Herein are a few specimen steps, annotated slightly'
   (1&":@([:depth'Ar' rp 'Rn' lp]);&(_25]\])])molecule
+-------------------------+-------------------------+
|0111111111122222222211122|CRnCaCaCaSiRnBPTiMgArSiRn|
|2233333222333333222222222|SiRnMgArSiRnCaFArTiTiBSiT|
|2222222111111111111111111|hFYCaFArCaCaSiThCaPBSiThS|
|1111111111222222223333221|iThCaCaPTiRnPBSiThRnFArAr|
|1111111111111111222221111|CaCaSiThCaSiThSiRnMgArCaP|
|1111222211111111122221111|TiBPRnFArSiThCaSiRnFArBCa|
|1122222333322222222211111|SiRnCaPRnFArPMgYCaFArCaPT|
|1111111111111111111111222|iTiTiBPBSiThCaPTiBPBSiRnF|
|2111111222222111222233332|ArBPBSiRnCaFArBPRnSiRnFAr|
|3333444443333322222222222|RnSiRnBFArCaFArCaCaCaSiTh|
|2222222222222223333222222|SiThCaCaPBPTiTiRnFArCaPTi|
|2222221111111111111112222|BSiAlArPBCaCaCaCaCaSiRnMg|
|2111111111000000000000011|ArCaSiThFArThCaSiThCaSiRn|
|1111111122222211100000111|CaFYCaSiRnFYFArFArCaSiRnF|
|1110000011111110000001111|YFArCaSiRnBPMgArSiThPRnFA|
|0000011110001111222222111|rCaSiRnFArTiRnSiRnFYFArCa|
|1122222111112222222111111|SiRnBFArCaSiRnTiMgArSiThC|
|1111111110011110001111000|aSiThCaFArPRnFArSiRnFArTi|
|0000000000000111111111100|TiTiTiBCaCaSiRnCaCaFYFArS|
|0000000000000000000001111|iThCaPTiBPTiBCaSiThSiRnMg|
|10000                    |ArCaF                    |
+-------------------------+-------------------------+
   NB. look at above to understand these results.
   decon molecule         NB. start the process
position: 227             NB. index 227 in each box
process: 4 SiRnBFAr       NB. level 4, at 227, work on SiRnBFAr
subst: Mg BF 231          NB. at 231, replace using Mg>BF
subst: Ca SiRnMgAr 227    NB. at 227, replace using Ca>SiRnMgAr
+-------------------------+-------------------------+
|0111111111122222222211122|CRnCaCaCaSiRnBPTiMgArSiRn|
|2233333222333333222222222|SiRnMgArSiRnCaFArTiTiBSiT|
|2222222111111111111111111|hFYCaFArCaCaSiThCaPBSiThS|
|1111111111222222223333221|iThCaCaPTiRnPBSiThRnFArAr|
|1111111111111111222221111|CaCaSiThCaSiThSiRnMgArCaP|
|1111222211111111122221111|TiBPRnFArSiThCaSiRnFArBCa|
|1122222333322222222211111|SiRnCaPRnFArPMgYCaFArCaPT|
|1111111111111111111111222|iTiTiBPBSiThCaPTiBPBSiRnF|
|2111111222222111222233332|ArBPBSiRnCaFArBPRnSiRnFAr|
|3333333322222222222222222|RnCaCaFArCaCaCaSiThSiThCa|
|2222222223333222222222222|CaPBPTiTiRnFArCaPTiBSiAlA|
|1111111111111112222211111|rPBCaCaCaCaCaSiRnMgArCaSi|
|1111000000000000011111111|ThFArThCaSiThCaSiRnCaFYCa|
|1122222211100000111111000|SiRnFYFArFArCaSiRnFYFArCa|
|0011111110000001111000001|SiRnBPMgArSiThPRnFArCaSiR|
|1110001111222222111112222|nFArTiRnSiRnFYFArCaSiRnBF|
|2111112222222111111111111|ArCaSiRnTiMgArSiThCaSiThC|
|1110011110001111000000000|aFArPRnFArSiRnFArTiTiTiTi|
|0000000111111111100000000|BCaCaSiRnCaCaFYFArSiThCaP|
|000000000000000111110000 |TiBPTiBCaSiThSiRnMgArCaF |
+-------------------------+-------------------------+
   NB. look at above to understand these results.
position: 25             NB. index 25 in each box
process: 3 SiRnMgAr      NB. level 3, at 25, work on SiMgAr
subst: Ca SiRnMgAr 25    NB. at 25, replace using Ca>SiRnMgAr
+-------------------------+-------------------------+
|0111111111122222222211122|CRnCaCaCaSiRnBPTiMgArSiRn|
|2222333333222222222222222|CaSiRnCaFArTiTiBSiThFYCaF|
|2111111111111111111111111|ArCaCaSiThCaPBSiThSiThCaC|
|1111222222223333221111111|aPTiRnPBSiThRnFArArCaCaSi|
|1111111111222221111111122|ThCaSiThSiRnMgArCaPTiBPRn|
|2211111111122221111112222|FArSiThCaSiRnFArBCaSiRnCa|
|2333322222222211111111111|PRnFArPMgYCaFArCaPTiTiTiB|
|1111111111111111222211111|PBSiThCaPTiBPBSiRnFArBPBS|
|1222222111222233332333333|iRnCaFArBPRnSiRnFArRnCaCa|
|3322222222222222222222222|FArCaCaCaSiThSiThCaCaPBPT|
|2223333222222222222111111|iTiRnFArCaPTiBSiAlArPBCaC|
|1111111112222211111111100|aCaCaCaSiRnMgArCaSiThFArT|
|0000000000011111111112222|hCaSiThCaSiRnCaFYCaSiRnFY|
|2211100000111111000001111|FArFArCaSiRnFYFArCaSiRnBP|
|1110000001111000001111000|MgArSiThPRnFArCaSiRnFArTi|
|1111222222111112222211111|RnSiRnFYFArCaSiRnBFArCaSi|
|2222222111111111111111001|RnTiMgArSiThCaSiThCaFArPR|
|1110001111000000000000000|nFArSiRnFArTiTiTiTiBCaCaS|
|0111111111100000000000000|iRnCaCaFYFArSiThCaPTiBPTi|
|000000000111110000       |BCaSiThSiRnMgArCaF       |
+-------------------------+-------------------------+

NB. skip a lot before the next example.
+-------------------------+-------------------------+
|0111111111111222222222222|CRnCaCaCaCaSiRnCaPTiTiBSi|
|2222222211111111111111111|ThFYCaFArCaCaSiThCaPBSiTh|
|1111111111122222222211111|SiThCaCaPTiRnPBSiAlArCaCa|
|1111111111112222211111111|SiThCaSiThSiRnMgArCaPTiBP|
|2222111111111222211111122|RnFArSiThCaSiRnFArBCaSiRn|
|2222222222221111111111111|CaCaPMgYCaFArCaPTiTiTiBPB|
|1111111111111122221111112|SiThCaPTiBPBSiRnFArBPBSiR|
|2222211122222222222222222|nCaFArBPRnCaCaCaCaSiThSiT|
|2222222222222222222222111|hCaCaPBPTiBCaPTiBSiAlArPB|
|1111111111112222211111111|CaCaCaCaCaSiRnMgArCaSiThF|
|1000000000000011111111112|ArThCaSiThCaSiRnCaFYCaSiR|
|2222211100000111111000001|nFYFArFArCaSiRnFYFArCaSiR|
|1111110000001111000001111|nBPMgArSiThPRnFArCaSiRnFA|
|0001111222222111112222211|rTiRnSiRnFYFArCaSiRnBFArC|
|1112222222111111111111111|aSiRnTiMgArSiThCaSiThCaFA|
|0011110001111000000000000|rPRnFArSiRnFArTiTiTiTiBCa|
|0000111111111100000000000|CaSiRnCaCaFYFArSiThCaPTiB|
|000000000000111110000    |PTiBCaSiThSiRnMgArCaF    |
+-------------------------+-------------------------+
position: 11         NB. index 25 in each box
process: 2 SiRnCaPTiTiBSiThFYCaFAr       NB. level 2
subst: F CaF 29      NB. at 25, replace using F>CaF
undone: YF           NB. no pattern exists for YF
subst: Al ThF 25     NB. so skip to ThF at 25
subst: F SiAl 23     NB. and so on  ...
subst: Mg BF 22
subst: Mg TiMg 20
subst: Mg TiMg 18
subst: F PMg 17
subst: F CaF 15
subst: Ca SiRnFYFAr 11

NB. Then we look at the very ending
NB.    at which the number 212 is print out of
NB.    "Count", the total number of steps.
NB. 
NB.  Now read from the bottom to the top to see
NB.    how the molecule can be constructed.

subst: F CaF 9
subst: Al ThF 7
subst: F SiAl 5  NB. etc.
subst: F CaF 3   NB. The third replacement, for F at 3
subst: Al ThF 1  NB. The second replacement, for Al at 1
subst: e NAl 0   NB. The "seed" pattern, apparently.
212
)

Another small example explores possible generalizations, extensions:

NB. frwd processes the molecule from left to right (forward).
NB.    I found it can be used after a backward deconstruction
NB.    if the deconstruction is then incomplete.
NB.    Such a case occurs with the 'HOHOHO' example.
frwd =. monad define
snip =.  y
count =. 0
while. #snip do.
   if. ''-: cod snip do. break. end.
   headofsnip=.  findhead snip
   t =.          ({:|:r) i. (<(s=.headofsnip))
   headofsnip =. >t{{.|:r
   snip =.       headofsnip,snip}.~#s
   smoutput 'subst: ',(rtake t),'  0'
   count =.      count + 1
end.
Count =: Count + count
snip,' ',":count
)

   r =: 0 3&{@;: ;._2] 0 : 0   
e => H
e => O
H => HO
H => OH
O => HH
)
   rtake =: ([,' ',])&>/@{&r     NB. get y'th pattern from r
   Count =: 0
   back 'HOHOHO _2'
subst: H HO 4
subst: H OH 3
subst: O HH 2
undone: OO
HOO _2
   frwd 'HOO'
subst: H HO  0
subst: H HO  0
subst: e H  0
e 3
   Count
6

Problem 20 (Package Delivery/Divisors)

Statement at Advent of Code: Infinite Elves and Infinite Houses

Part 1
= Contribution from Henry Rich:
The old sum-of-divisors problem, solvable without enumerating them.

   goal =: 29000000
   NB. The sum-of-divisors problem
   (goal%10) >:@]^:(> >:@#.~/.~&.q:)^:_ (1)

Part 2
Contribution from Henry Rich:
For the modified problem the easiest and fastest solution is to realize the set of divisors and throw out ones that are too small.

   NB. use */\ rather than ^ to keep things integral
   sumoflargedivisors =: ([: +/ <.@%&50@<: ((< # ]) >) [: ,@:(*/)&.>/ [: */\@:(1 , #~)&.>/ __&q:)
   goal >:@]^:(>   11 * sumoflargedivisors)^:_ (2)

Problem 21 (RPG Simulation I)

Statement at Advent of Code: RPG Simulator 20XX
A role-playing game.

Part 1
Contribution from Henry Rich:

NB. Get problem input: weapons, armor, rings.  Make armor negative, so that everything is units of attack
'w a r' =: 1 1 _1&*"1&.> (<@:((0 ". 12&}.)@>);._1~ ':'&e.@>) <;._2 (#~ (LF,LF) -.@:E. ]) ,&LF wd 'clippaste'
NB. Get personal input, from the problem
ourpoints =:  100
bosspoints =: 100
bossstats =:  _2 8
NB. Enumerate choices.  Add a 0-line to a and r to allow buying nothing;
NB. Take r by pairs to allow buying 2, but remove principal diagonal to prevent
NB.  buying the same thing twice 
choices =: ,/@:(+"1/)&:>/ w; (0,a); (~. ,/ (-. =/~ i. >:#r) * +"1/~ 0,r)
NB. Find ones that win, choose smallest cost
<./ ((<:/"1)@:>.@:((bosspoints,ourpoints)&%"1)@:(1&>."1)@:(bossstats&+"1)@:(}."1) # {."1) choices

Part 2
Contribution from Henry Rich:

NB. Find ones that lose, choose largest cost
>./ ((>/"1)@:>.@:((bosspoints,ourpoints)&%"1)@:(1&>."1)@:(bossstats&+"1)@:(}."1) # {."1) choices

Problem 22 (RPG Simulation II)

Statement at Advent of Code: Wizard Simulator 20XX
A role-playing game.

Part 1
Contribution from Henry Rich:

NB. Timer actions.  Each row gives the changes when the given effect is operational
timeractions =: ".;._2 (0 : 0)
0  0 0 0 _1 0 0   NB. Shield - just decr timer (armor happens in boss turn)
_3 0 0 0 0 _1 0   NB. Poison - hurt the boss
0 0 101 0 0 0 _1  NB. Recharge - add to our mana
)

NB. Spell actions.  Gives the change in state at the moment the spell is applied
spellactions =: ".;._2 (0 : 0)
0 0 _113 113 6 0 0 NB. Shield
0 0 _173 173 0 6 0 NB. Poison
0 0 _229 229 0 0 5 NB. Recharge
_4 0 _53 53 0 0 0  NB. Missile
_2 2 _73 73 0 0 0  NB. Drain
)

NB. Simulate the game
NB. y is (boss start points),(boss damage)
NB. x is hard flag
gamesim =: 3 : 0
0 gamesim y
:
'bosspoints bossdamage' =. y
minwincost =: 1e8
NB. A game state is
NB.  (boss points),(our points),(our mana),(our spend so far),timers
NB. where timers are: shield,poison,recharge
states =. ,: bosspoints , 50 500 0  0 0 0
while. #states do.
  NB. Player's turn:  first, the hard flag.  Take away 1 point and check for losers
  if. x do.
    states =. 0 _1 0 0 0 0 0 +"1 states
    if. # loselines =. 0 I.@:>: 1 {"1 states do.
      states =. (<<<loselines) { states
    end.
  end.

  NB. process timers
  states =. states + (* _3 {."1 states) +/ . * timeractions

  NB. Find winning states (ones knocked out by the timers); update min cost
  NB. Since we need the best win, rather than the path to it, just remember the
  NB.  cheapest win.  We will continue casting spells on it and eventually remove it
  minwincost =. minwincost <. <./ (<(0 I.@:>: 0 {"1 states);3) { states

  NB. Get mask of allowable spells for each state.  Missile and Drain always allowed
  allowspells =. (0 = _3 {."1 states) ,"1 (1 1)

  NB. Perform the spell
  states =. (+/"1 allowspells) # states  NB. Replicate state for each spell
  states =. states + allowspells ;@:(<@#/) spellactions

  NB. Remove states with negative mana - they were illegal moves
  if. # implines =. 0 I.@:> 2 {"1 states do.
    states =. (<<<implines) { states
  end.

  NB. Find winning states (knocked out by the spell); update min cost
  NB. (copied from above:)
  minwincost =. minwincost <. <./ (<(0 I.@:>: 0 {"1 states);3) { states

  NB. Remove any high-cost states, which could have come from an improved win or
  NB.  increased expense
  states =. (minwincost > 3 {"1 states) # states

  NB. Boss's turn: save armor state before timers are processed
  armorvalue =. 7 * * 4 {"1 states

  NB. process timers
  states =. states + (* _3 {."1 states) +/ . * timeractions

  NB. Find winning states (knocked out by timers); update min cost
  NB. (copied from above:)
  minwincost =. minwincost <. <./ (<(0 I.@:>: 0 {"1 states);3) { states

  NB. Calculate result of boss's move
  NB. The damage inflicted depends on our armor, which depends on the shield timer
  ournewpoints =. (1 {"1 states) - 1 >. bossdamage - armorvalue
  states =.       ournewpoints (<a:;1)} states

  NB. Remove losing states
  if. # loselines =. 0 I.@:>: ournewpoints do.
    states =. (<<<loselines) { states
  end.

  NB. Remove duplicate states, which there seem to be plenty of
  states =. ~. states
end. 
minwincost
)
gamesim bossinfo

Part 2
Contribution from Henry Rich:

1 gamesim bossinfo

Problem 23 (Microprocessor Simulation)

Statement at Advent of Code: Opening the Turing Lock
Contribution from Henry Rich:

NB. Machine simulator
NB. Machine state is (register a),(register b),(pc)

NB. Read input and convert to internal instruction form,
NB.  an Atomic Representation for each instruction

NB. Converters for each opcode
NB. Each creates an AR that operates on machstate to create a new machstate
hlf =: (3 : '{. (0 0 1 + (y}~ <.@-:@(y&{)))`0:')
tpl =: (3 : '{. (0 0 1 + (y}~ 3 * (y&{)))`0:')
inc =: (3 : '{. (0 0 1 + (y}~ 1 + (y&{)))`0:')
jmp =: (3 : '{. (2}~ y + (2&{))`0:')
jie =: (4 : '{. (2}~ (2&{ + (y,1) {~ 2 | x&{))`0:')/
jio =: (4 : '{. (2}~ (2&{ + (1,y) {~ 1 = x&{))`0:')/
'a b' =: 0 1  NB. register indices [aid to understanding]

NB. Read & convert the program
program =: ".;._2  (#~ (LF,LF) -.@E. ]) wd 'clippaste'

NB. Simulator.  y is the program, x is the initial state (default 0 0 0)
NB. Initialize machine state, run instructions until we get an error fetching one
simprog =: 4 : 0
machstate =. x
while. do.
  if. 0 1 -.@-: (0,#y) > pc =. 2 { machstate do. break. end.
  machstate =. (pc{y)`:6 machstate 
end.
machstate
)
0 0 0 simprog program

Part 2
Contribution from Henry Rich:

1 0 0 simprog program

Contribution from Pascal Jasmin (talk) 18:25, 27 December 2015 (UTC):

    p2 =.  cut"1 '-_' rplc~"1 ',+' -.~"1 a2  =. > cutLF wdclippaste
    maybenum =: 0&".^:(] -:&(, $~ 1 -.~ $) ":@:(0&".^:(2 = 3!:0)))
    lr =: 3 : '5!:5 < y'
    DO =:  ] + ".@:([: ;: inv [: ({. , 1&{ , lr@maybenum leaf@{: ) 2 0 1  { {~)
    jmp =: ]
    inc =: 3 : '1 [ (y) =: >: y~'
    tpl =: 3 : '1 [ (y) =: 3 *  y~'
    hlf =: 3 : '1 [ (y) =: -:  y~'
    jio =: 4 : '(1 , x) {~ 1 =  y~'
    jie =: 4 : '(x, 1) {~ 2 |  y~'
    p2 DO^:( #@[ > ])^:(_) 0  [ b =: 0x [ a =: 1x

Problem 24 (Divide The Weights)

Statement at Advent of Code: It Hangs in the Balance

Part 1
Contribution from Henry Rich:
The Integer Knapsack Problem again.

NB. Read in data, convert to list of package weights
i =: ".;._2 (#~ (LF,LF) -.@:E. ]) LF ,~ wd 'clippaste'

NB. Get all the ways to add up to 1/3 the weight
solutionmask =: i iknapsack 2 ,~ goal =: 3 %~ +/ i
NB. Cull to ones that have minimum # packages
minsolutions =: ((= <./) +/"1 solutionmask) # solutionmask
NB. For each solution, see if the remaining packages can be split into 2 equal parts.
NB. Keep only solutions that can.
feasmin =: (((-. minsolutions) # i) iknapsack goal,0) # minsolutions
NB. Find minimum QE
<./ */"1 feasmin # i

This program uses the verb iknapsack defined at: IntegerKnapsack.

Contribution from Pascal Jasmin (talk) 18:13, 27 December 2015 (UTC):

    combT =: ([: ; ([ ; [: i.@>: -~) ((1 {:: [) ,.&.> [: ,&.>/\. >:&.>@:])^:(0 {:: [) (<i.1 0),~ (< i.0 0) $~ -~)
    ] a =.        ". > cutLF wdclippaste ''  NB. input
    s =.          3 %~ +/ a
    /:~ */"1 f =. (#~ s = +/"1) a {~ 6 combT #a

Part 2
Contribution from Henry Rich:

NB. Utility adverb: apply u to successive items of y.  Returns item when (u item) returns nonzero
NB. Returns empty if no match
first =: 1 : 0
for_i. y do. if. u i do. i return. end. end.
0$0
)
NB. Get the feasible solutions
solutionmask =: i iknapsack 1 ,~ goal =: 4 %~ +/ i
NB. Cull to ones that have minimum # packages
minsolutions =: ((= <./) +/"1 solutionmask) # solutionmask
NB. Order on QE
ordsolutions =: (/: +/"1 ,. */@:(#&i)"1) minsolutions
NB. Utility verb: x is all solutions, y is one solution, result is table of solutions in x that
NB.  do not have any overlap with y
nonoverlaps =: (-.@:((+./@:*.)"1) # [)
NB. Process the solutions in order of desirability.  Remembering that solutionmask knows ALL the
NB.  solutions, we find all the possible solutions for the second group given the first group.  The
NB.  question then is whether the remaining half of the weight can be split evenly.  If it can, we have
NB.  a winner.
NB. The search is done stopping on the first match, to save unnecessary computation
*@#@((goal iknapsack 0 ,~ #&i) first)@(+."1  solutionmask&nonoverlaps) first ordsolutions

Contribution from Pascal Jasmin (talk) 18:18, 27 December 2015 (UTC):

    s =.          4 %~ +/ a  NB. part 2 sum target
    /:~ */"1 f =. (#~ s = +/"1) a {~ 5 combT #a  NB. if f has no items, then try longer group.

Problem 25 (Cantor's Password)

Statement at Advent of Code: Let It Snow

Part 1
Contribution from Henry Rich:

(20151125) 33554393&|@* (252533) 33554393&|@^ <: row (] + 2 ! <:@+) col

Contribution from (Pascal Jasmin (talk)) 18:13, 27 December 2015 (UTC):

For input 3019 column, 3010 row:

     next =: 33554393 | 253533 * ]
     next^:(3019 ([ + [: +/@i. 2-~ +)  3010) 20151125