diff --git a/extra/project-euler/215/215-tests.factor b/extra/project-euler/215/215-tests.factor new file mode 100644 index 0000000000..ddd87cc2ff --- /dev/null +++ b/extra/project-euler/215/215-tests.factor @@ -0,0 +1,5 @@ +USING: project-euler.215 tools.test ; +IN: project-euler.215.tests + +[ 8 ] [ 9 3 solve ] unit-test +[ 806844323190414 ] [ euler215 ] unit-test diff --git a/extra/project-euler/215/215.factor b/extra/project-euler/215/215.factor new file mode 100644 index 0000000000..056de72e50 --- /dev/null +++ b/extra/project-euler/215/215.factor @@ -0,0 +1,56 @@ +USING: accessors kernel locals math ; +IN: project-euler.215 + +TUPLE: block two three ; +TUPLE: end { ways integer } ; + +C: block +C: end +: 0 ; inline +: 1 ; inline + +: failure? ( t -- ? ) ways>> 0 = ; inline + +: choice ( t p q -- t t ) [ [ two>> ] [ three>> ] bi ] 2dip bi* ; inline + +GENERIC: merge ( t t -- t ) +GENERIC# block-merge 1 ( t t -- t ) +GENERIC# end-merge 1 ( t t -- t ) +M: block merge block-merge ; +M: end merge end-merge ; +M: block block-merge [ [ two>> ] bi@ merge ] + [ [ three>> ] bi@ merge ] 2bi ; +M: end block-merge nip ; +M: block end-merge drop ; +M: end end-merge [ ways>> ] bi@ + ; + +GENERIC: h-1 ( t -- t ) +GENERIC: h0 ( t -- t ) +GENERIC: h1 ( t -- t ) +GENERIC: h2 ( t -- t ) + +M: block h-1 [ h1 ] [ h2 ] choice merge ; +M: block h0 drop ; +M: block h1 [ [ h1 ] [ h2 ] choice merge ] + [ [ h0 ] [ h1 ] choice merge ] bi ; +M: block h2 [ h1 ] [ h2 ] choice merge swap ; + +M: end h-1 drop ; +M: end h0 ; +M: end h1 drop ; +M: end h2 dup failure? [ ] unless ; + +: next-row ( t -- t ) [ h-1 ] [ h1 ] choice swap ; + +: first-row ( n -- t ) + [ ] dip + 1- [| a b c | b c a b ] times 2drop ; + +GENERIC: total ( t -- n ) +M: block total [ total ] dup choice + ; +M: end total ways>> ; + +: solve ( width height -- ways ) + [ first-row ] dip 1- [ next-row ] times total ; + +: euler215 ( -- ways ) 32 10 solve ;