\ Contributed by Ian Osgood

\ read NUM from last command line argument
0. argc @ 1- arg >number 2drop drop constant NUM

create a NUM allot
a NUM 1- + constant a-last
create pan NUM allot
create counts NUM allot
0 value #perms

$8200 allot

: .pan ( a -- ) NUM 0 do dup c@ 1 u.r 1+ loop drop cr ;

: flip ( n -- )
  dup pan +  swap 2/ pan +  pan do
    1-  i c@ over c@  i c! over c!
  loop drop ;

: flips ( -- n )
  0 begin pan c@ 1 > while 1+  pan c@ flip repeat ;

: fannkuch ( -- max-flips )
  NUM 0 do i 1+  a i + c! loop
  0 NUM ( max-flips r )
  begin
    \ print first 30 permutations
    #perms 30 < if a .pan  #perms 1+ to #perms then

    \ eliminate bad pans
    a c@ 1 > if a-last c@ NUM < if
      \ fill the pan and start flipping
      a pan NUM move
      swap flips max swap
    then then

    \ next permutation
    begin dup 1 > while dup 1- tuck counts + c! repeat
    begin dup >r  a c@  a 1+ a r@ cmove  a r> + c!      \ roll
          dup counts +  dup c@ 1-  dup rot c!  0=
    while 1+  dup NUM = if drop exit then
    repeat
  again ;

fannkuch ." Pfannkuchen(" NUM 1 u.r ." ) = " 1 u.r cr bye
