/ this version requires that m <= n, and that n is odd and > 1 bal:1!'(0 0;1 1),\: / grow balanced rows sym:{~/(::;|:)@'(1 -1*_.5*#x)#\:x} / is x symmetrical? ok3:{ac3 .-3#x} / last 3 rows ok? ac3:{&/5>x+z+lr y} / fewer than 5 neighbors? ok2:{ac2 .-2#x} / last 2 rows ok? ac2:{&/4>x+lr y} / fewer than 4 neighbors? lr:{x+1_-1_(1!t)+(-1!t:1,x,1)} / horizontal neighbors on row:{[k;b] / matrix -> .. matrix + row .. h:3=lr c:*-1#b / on and horizontal neighbors on r:(~c)|(~h)|h&~*-2#b / base row if[~n:+/p:h&r;:,b,,c] / if no new rows, duplicate last a:+@[r;&p;:;(n#2)_vs!(-&/r@&~p)+_2^n] / generate new rows a@:&sym'a / prune asymmetric rows a@:&k<+/'a / prune certain losers r:b,/:+,a / matrix + possibles r@&ok3'r} / keep where last-1 row is accessible garden:{[m;n] / m rows, n cols k:n-1+-_-_sqrt n / minimum plants on a row a:-1_(_ n%2)(,/bal')/0 1 / balanced rows - all 1s a@:&k<+/'a / prune certain losers b:,/,/:\:/2#,+,a / all pairs of candidate rows b@:&(ok2@|:)'b / keep where first row is accessible r:(m-2)(,/row[0|k-1]')/b / candidate layouts r@:&ok2'r / keep where last row is accessible s:+//'r / scores r@&s=|/s} / keep winners / tools & timings run:{[n;m] a:,/k,/:'(k:3_!1+n)_\:!1+m a@:&a[;1]!2 t:c:s:r:&#a i:0;do[#a b:_T;r[i]:garden . a i t[i]:_86400000*_T-b \a[i],t i c[i]:#r i s[i]:+//~*r i i+:1] (+a),(t;c;s;r)} get:{[t;m;n] i:_n if[~m~_n;i@:&m=t 0] if[~n~_n;i@:&n=t[1]i] t[;i]} ok:{&//~x>unbox 4>+/rot box x} / is every plant accessible? box:{+1,(+1,x,1),1} / put 1s on all sides of a matrix rot:(1!;-1!;1!';-1!')@\: / NSEW rotations unbox:1_-1_1_'-1_' / drop outer rows, cols of a matrix {`0:,/'7$+5#x}t:run[11;11] \ results: 3.0 ghz rows cols ms # empties ---- ---- -- - ------- 3 3 0 6 1 3 5 0 1 4 3 7 0 1 6 3 9 0 1 7 3 11 15 4 10 4 5 0 2 6 4 7 0 2 7 4 9 0 6 10 4 11 15 1 11 5 5 0 1 7 5 7 0 7 10 5 9 0 6 12 5 11 31 3 14 6 7 15 1 11 6 9 0 4 14 6 11 78 3 17 7 7 15 2 12 7 9 15 1 16 7 11 203 3 19 8 9 31 1 18 8 11 531 7 22 9 9 78 12 21 9 11 1390 1 24 10 11 3671 2 27 11 11 9687 19 30 =================================================================================== / http://developers.slashdot.org/article.pl?sid=05/03/14/2258219&tid=156&tid=8 / http://hcsoftware.sourceforge.net/jason-rohrer/worklog/index.php?y=2005&m=3&d=14 / http://sleepingsquirrel.org/garden/garden.hs from http://hcsoftware.sourceforge.net/jason-rohrer/worklog/index.php?y=2005&m=3&d=14: The garden layout problem is as follows: Given a garden laid out on an mxn grid, you must place "Planted" and "Empty" cells on the grid so that you can reach each Planted cell while standing in an Empty cell. In other words, for each Planted cell, one of its four neighbors (no diagonals) must be Empty. Thus, you can tend your garden without ever standing in the planted areas (which would compact the soil and potentially damage the plants that are growing there). Of course, you want to maximize the amount of space used for plants in the garden, so you want to solve the above problem with the minimum number of Empty cells. This optimization problem is equivalent to the well-known Dominating Set problem on a grid graph (Dominating Set on a general graph is NP-complete, but it is uknown whether Dominating Set restricted to grid graphs is NP-complete). A dominating set in a graph is a set of vertices such that every vertex is either in the set or connected to a vertex in the set by an edge. N.B.: http://developers.slashdot.org/comments.pl?sid=142494&cid=11944864 / haskell hardwired for nx3 solutions, so we can have: ok:{&//~x>1_-1_1_'-1_'4>+/(1!;-1!;1!';-1!')@\:+1,(+1,x,1),1} / is every plant accessible? bal:{[v]0 1,'v,/:0 1} / grow balanced rows run:{[n] / m rows, n cols a:-1_(_ n%2)(,/bal')/0 1 / all balanced rows a@:&(+/'a)>n-(n!2)+-_-_sqrt n / not too many empties a@:+(3##a)_vs&,//a{{ok(x;y;z)}[x;y]'a}/:\:a / restrict to ok a@&s=|/s:+//'a} / restrict to best \ results: 3.0 ghz n ms # +//~* --- ---- - ----- 9 0 1 7 7 0 2 6 / this version flips m, n if m > n / handles even m, but not nicely, and the even cases are slow (?) run:{[m;n](::;+:)[t]@/:garden .(t:m>n)!(m;n)} / flip if m>n bal:1!'(0 0;1 1),\: / grow balanced rows sym:{[o;v]:[o;sym1 v;|/sym1'1_-1_\:v]} / is v symmetrical? sym1:{[v]~/(::;|:)@'(1 -1*_.5*#v)#\:v} / is odd v symmetrical? ok3:{ac3 .-3#x} / last 3 rows ok? ac3:{[a;b;c]&/5>a+c+lr b} / no more than 4 neighbors ok2:{ac2 .-2#x} / last 2 rows ok? ac2:{[a;b]&/4>a+lr b} / nore than 3 neighbors lr:{x+1_-1_(1!t)+(-1!t:1,x,1)} / horizontal neighbors on row:{[o;k;b] / matrix -> .. matrix + row .. h:3=lr c:*-1#b / on and horizontal neighbors on r:(~c)|(~h)|h&~*-2#b / base row if[~n:+/p:h&r;:b,,c] / if no new rows, duplicate last a:@[r;&p;:;]'+(n#2)_vs!(-&/r@&~p)+_2^n / generate new rows a@:&sym[o]'a / prune asymmetric rows a@:&k<+/'a / prune certain losers {x@&ok3'x}b{x,,y}/:a} / valid matrix + possibles garden:{[m;n] / m rows, n cols o:n!2 / odd cols k:n-o+-_-_sqrt n / minimum plants on a row a:-1_(-~o)_'(_ n%2)(,/bal')/0 1 / balanced rows - last if even - 1s a@:&k<+/'a / prune certain losers b:,/a{(x;y)}/:\:a / all pairs of candidate rows b@:&(ok2@|:)'b / keep where first row is accessible r:(m-2)(,/row[o;0|k-1]')/b / candidate layouts r@:&ok2'r / keep where last row is accessible s:+//'r / scores r@&s=|/s} / keep winners / timing Run:{[n;m] a:,/k,/:'(k:3_!1+n)_\:!1+m t:c:s:&#a i:0;do[#a b:_T;q:run . a i t[i]:_86400000*_T-b \a[i],t i c[i]:#q s[i]:+//~*q i+:1] (+a),(t;c;s)} {`0:,/'7$+x}Run[9;11] \ results: 3.0 ghz rows cols ms # empties ---- ---- -- - ------- 3 3 0 6 1 3 4 0 1 4 3 5 0 1 4 3 6 0 2 6 3 7 15 1 6 3 8 0 1 7 3 9 0 1 7 3 10 0 2 9 3 11 0 4 10 4 4 0 1 4 4 5 0 2 6 4 6 0 4 7 4 7 0 2 7 4 8 0 2 9 4 9 0 6 10 4 10 15 3 11 4 11 15 1 11 5 5 0 1 7 5 6 0 1 8 5 7 0 7 10 5 8 0 3 11 5 9 15 6 12 5 10 46 1 13 5 11 31 3 14 6 6 0 4 10 6 7 15 1 11 6 8 0 1 12 6 9 15 4 14 6 10 328 17 16 6 11 78 3 17 7 7 15 2 12 7 8 15 9 15 7 9 15 1 16 7 10 1937 11 18 7 11 203 3 19 8 8 46 1 16 8 9 31 1 18 8 10 12484 1 20 8 11 531 7 22 9 9 93 12 21 9 10 76094 34 23 9 11 1453 1 24 ------------------------------ / ok[garden] = 1 iff ok ok:{&//~x>unbox 4>+/rot box x} / is every plant accessible? box:{+1,(+1,x,1),1} / put 1s on all sides of a matrix rot:(1!;-1!;1!';-1!')@\: / NSEW rotations unbox:1_-1_1_'-1_' / drop outer rows, cols of a matrix ------------------------------ / first version: score:{[a;b;c]plants[a;b;c]blocked[1,a,1;1,b,1]1,c,1} / score three rows plants:{[a;b;c;s]:[s|&/c;0N;+/a+b+c]} / total or 0N if blocked blocked:{[a;b;c]|/1_-1_ a&b&c&(1!b)&-1!b} / are middle-row plants blocked? best:{[s;t](^s)_vs&,/s>(-t)+|//s} / indices of best scores ok:{&//~x>1_-1_1_'-1_'4>+/(1!;-1!;1!';-1!')@\:+1,(+1,x,1),1} / is every plant unblocked? run:{[m;n](::;+:)[t]@/:garden .(t:m>n)!(m;n)} / flip if m>n garden:{[m;n] / m rows, n cols a:+(n#2)_vs!_2^n / all rows of length n s:a score[*-1#a]/:\:a / initial: score 1s + all pairs r:*(~#*:)(matrix[m;a;s].)/(();1) / continue while not empty r@&(|/t)=t:+//'r} / return best gardens matrix:{[m;a;s;r;t] / #rows, all rows, scores, last, tolerance r:(m-2)row[t;a]/a@+best[s]t / append m-2 rows to best initial two rows (r@&ok'r;1+t)} / return accessible, tolerance + 1 row:{[t;a;b] / tolerance, all rows, rows so far i:best[(-2#'b){score[;;y]. x}/:\:a]t / best of last two rows + each row b[*i],'+,a i 1} / append best new rows to rows so far \ results: 3.0 ghz mxn ms # +//~* --- ---- - ----- 3 9 2640 1 7 3 7 140 8 6 4 4 0 2 4 7 7 937 1 12 -----------------------------