Essays/Advent Of Code
Advent Of Code
[Advent Of Code] is a set of programming problems devised by Eric Wastl. They were originally posted in December 2015, one pair of problems per day.
The problems are suitable for all levels of programmer. Solutions are posted here to demonstrate J's value as a general-purpose programming language.
Introduction
Problem 1 (Count Parentheses)
input is a file containing randomly chosen parenthesis characters starting with "(". "(" means "go up a floor", ")" means "descend 1 floor". puzzle: On what floor does Santa finish? Start at 0.
Part 1
read=: 1!:1@boxopen mp=: +/ .* PART1=: +/ 1 _1 mp '()'=/read'input'
-- contributed by David Lambert
Part 2
NB. part 2 puzzle: when does Santa enter the basement? PART2=: >: _1 i.~ +/\ 1 _1 mp '()'=/read'input'
-- contributed by David Lambert
Problem 2 (Wrapping Paper)
input is a file such as
4x23x21 22x29x19
Part 1
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 length, width, and height. 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
-- contributed by David Lambert
Part 2
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
-- contributed by David Lambert
Problem 3 (Package Delivery)
Idea contributed by Alex Shroyer
Here the input file contains a sequence of characters randomly chosen from <>v^ . How many homes on this 2D grid receive at least one visit? The characters indicate to move one cell in pointed direction.
NB. Complex number review: Successive multiplications give right, up, left, down increments, NB. corresponding to 0, 90, 180, or 270 degrees. (North is to the right and the compass is NB. right-handed, if your mental picture is geocentric.) 0j1(^i.)4 1 0j1 _1 0j_1
Part 1
Contributed by 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, which explains the reversal (|.). Starting location and traversal direction shouldn't affect the solution. With the locations known, we just need the tally of the nub.
read=: 1!:1@:boxopen ROUTE=: |. read 'input' tour=: (] , (+ {:))/@:(0 ,~ ((0j1(^i.)4) {~ '>^<v'&i.)) PART1=: # ~. tour ROUTE
Part 2
Contributed by David Lambert
The Part-2 puzzle splits the deliveries among 2 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: 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 the maximum index values are bounded. (If the tally is n, then the valid non-negative indexes are on [0, n-1]).
NB. Draw the drunken walk require 'viewmat' xy=: (-"1 <./)@:+. viewmat@:((>:@:i.@:#@:[)`(<"1@:[)`(])} (0 $~ >:@:(>./)))@:xy@:visits ROUTE
Problem 4 (MD5)
Given a key, say 'abcdef' append incremental numbers until the md5 hash starts with 5 zeros. 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. 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. diagest=. 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. standart 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'
-- contributed by Moon S https://github.com/georgiy-pruss/2-J/blob/master/md5.ijs
With this code we continue to part 1. The hooked sentence (copy~ selection"_1)DATA is often useful.
Part 1
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
-- contributed by David Lambert
Part 2
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
-- contributed by David Lambert
Problem 5 (Find Nice Strings)
Part 1
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
-- contributed by David Lambert
|.!.
customized shift reminded to us
-- by Henry Rich
Part 2
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
-- contributed by Henry Rich
Problem 6 (Light Control)
Part 1
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: 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
NB. Same idea, with different definition of off/on/toggle '`off on toggle' =: (0 >. -)`+`(+ +:) +/@, 3 : i 1000 1000 $ 0
-- contributed by Henry Rich
Problem 7 (Wiring Simulation)
Part 1
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
-- contributed by Henry Rich
Part 2
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
-- contributed by David Lambert
Problem 8 (Counting Escaped Characters)
Part 1
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
-- contributed by Henry Rich
Using sequential machine, and with file input
containing the input
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'
-- contributed by David Lambert
Part 2
NB. For each line: 2 for outer quotes, plus one for each character that must be escaped +/ (2 + +/@(e.&'"\'))@> i
-- contributed by Henry Rich
Problem 9 (Traveling Salesman)
Part 1
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
-- contributed by Henry Rich
Part 2
NB. Same, but find longest path >./ (i.@! ([: +/ i (<"1@[ { ])~ 2 ]\ A.)"0 _ i.) #i
-- contributed by Henry Rich
Problem 10 (Look And Say)
Part 1
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
-- contributed by Henry Rich
Part 2
Like part 1, but change the 40 to 50.
Problem 11 (Password Update)
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.
Part 1
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 unallowed values inc =: ]&.((8#26)&#.) @: (+ [: 1&((_1)})^:(0 = *./) (e.&(LC i. 'oil'))) smoutput npw =. inc^:(hasoil +. straight *: twopair)^:_@inc &.(LC&i.) i
-- contributed by Henry Rich
On account of the E. bug I used c patterned after what would have been the j program. This code used the trick noted in the introduction.
/* Let this be the file c.c . adventofcode.com/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 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; }
-- contributed by David Lambert
Part 2
smoutput inc^:(hasoil +. straight *: twopair)^:_@inc &.(LC&i.) npw
-- contributed by Henry Rich
Problem 12 (JSON Parsing)
Part 1
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 number, which joins the '-' to the value; then sum the results +/ (0&".@;;.2~ ~:&(<,'-')) (#~ '-0123456789' e.~ {.@>) ;i
-- contributed by Henry Rich
Part 2
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 here. -- contributed by Henry Rich
Problem 13 (Cyclic Permutations)
Part 1
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
-- contributed by Henry Rich
Part 2
NB. Adding a dummy is equivalent to not closing the ring maxhap2 =: >./ (i.@! ([: +/ i (<"1@[ { ])~ 2 ]\ A.)"0 _ i.) #i
-- contributed by Henry Rich
Problem 14 (Reindeer Speeds)
Part 1
NB. Read in data, convert to numeric. Result is table where each row NB. 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
-- contributed by Henry Rich
Part 2
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
-- contributed by Henry Rich
Problem 15 (Cookie Recipes)
Part 1
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
-- contributed by Henry Rich
Part 2
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, find ones NB. 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
-- contributed by Henry Rich
Problem 16 (Database Search)
Part 1
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
-- contributed by Henry Rich
Part 2
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
-- contributed by Henry Rich
Problem 17 (Integer Knapsack)
This problem could be solved by exhaustive search, but it can be solved quicker as an instance of the Integer Knapsack Problem.
Part 1
NB. Read in data, convert to list i =: ".;._2 (#~ (LF,LF) -.@:E. ]) wd 'clippaste' # solutions =: i iknapsack 150 2
This program uses the verb iknapsack defined here. -- contributed by Henry Rich
Part 2
(+/@:= <./) +/"1 solutions
-- contributed by Henry Rich
Problem 18 (Game Of Life)
Part 1
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
-- contributed by Henry Rich
Untestable 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' 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
-- contributed by David Lambert
Part 2
<cornerson =: 1&((<;~0 _1)}) +/@:, cornerson@life^:100 cornerson i
-- contributed by Henry Rich
Problem 19 (String Replacement)
Part 1
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 the case NB. (solution would be to add a pattern '';'' , which would remove ALL the self-replacements, and then NB. 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
-- contributed by Henry Rich
Part 2
I spent hours thinking about part 2 before coding anything. Finally I decided that it would be unfeasible 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
-- contributed by Henry Rich
Addendum to Part 2
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
-- contributed by Brian Schott
Problem 20 (Package Delivery/Divisors)
Part 1
The old sum-of-divisors problem, solvable without enumerating them.
goal =: 29000000 NB. The sum-of-divisors problem (goal%10) >:@]^:(> >:@#.~/.~&.q:)^:_ (1)
-- contributed by Henry Rich
Part 2
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)
-- contributed by Henry Rich
Problem 21 (RPG Simulation I)
Part 1
NB. Get problem input: weapons, armor, rings. Make armor negative, so 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
-- contributed by Henry Rich
Part 2
NB. Find ones that lose, choose largest cost >./ ((>/"1)@:>.@:((bosspoints,ourpoints)&%"1)@:(1&>."1)@:(bossstats&+"1)@:(}."1) # {."1) choices
-- contributed by Henry Rich
Problem 22 (RPG Simulation II)
Part 1
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
-- contributed by Henry Rich
Part 2
1 gamesim bossinfo
-- contributed by Henry Rich
Problem 23 (Microprocessor Simulation)
Part 1
NB. Machine simulator NB. Machine state is (register a),(register b),(pc) NB. Read input and convert to internal instruction form, which is NB. an AR 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 numbers 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
-- contributed by Henry Rich
Part 2
1 0 0 simprog program
-- contributed by Henry Rich
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
--Pascal Jasmin (talk) 18:25, 27 December 2015 (UTC)
Problem 24 (Divide The Weights)
Part 1
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 here. -- contributed by Henry Rich
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
--Pascal Jasmin (talk) 18:18, 27 December 2015 (UTC)
Part 2
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
-- contributed by Henry Rich
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.
--Pascal Jasmin (talk) 18:18, 27 December 2015 (UTC)
Problem 25 (Cantor's Password)
Part 1
(20151125) 33554393&|@* (252533) 33554393&|@^ <: row (] + 2 ! <:@+) col
-- contributed by Henry Rich
for input 3019 column, 3010 row. next =: 33554393 | 253533 * ] next^:(3019 ([ + [: +/@i. 2-~ +) 3010) 20151125
--Pascal Jasmin (talk) 18:13, 27 December 2015 (UTC)