USING: kernel math arrays sequences combinators ;
IN: project-euler.215

: firstTree ( n -- t )
  [ 0 1 0 ] dip
  1- [ dupd 2array -rot ] times 2drop ;

: total ( t -- n )
  dup array? [ [ total ] sigma ] when ;

: merge ( t t -- t )
  {
    { [ 2dup [ array? ] both? ] [ [ first2 ] bi@ swapd [ merge ] 2bi@ 2array ] }
    { [ 2dup [ integer? ] both? ] [ + ] }
    { [ dup 0 = ] [ drop ] }
    [ nip ]
  } cond ;

DEFER: h-1
DEFER: h0
DEFER: h1
DEFER: h2

: choice ( t p q -- t t )
  [ first2 ] 2dip bi* ;

: stepper ( t -- t )
  [ h-1 ] [ h1 ] choice swap 2array ;

: h-1 ( t -- t )
  dup array? [
    [ h1 ] [ h2 ] choice merge
  ] [
    drop 0
  ] if ;

: h0 ( t -- t )
  dup integer? [ drop 0 ] unless ;

: h1 ( t -- t )
  dup array? [
    [ [ h1 ] [ h2 ] choice merge ]
    [ [ h0 ] [ h1 ] choice merge ] bi 2array
  ] [
    drop 0
  ] if ;

: h2 ( t -- t )
  {
    { [ dup array? ] [ [ h1 ] [ h2 ] choice merge 0 swap 2array ] }
    { [ dup zero? ] [ ] }
    [ 0 2array ]
  } cond ;

: solve-215 ( width height -- ways )
  [ firstTree ] dip 1- [ stepper ] times total ;