extra/project-euler/186/186.factor

   1 USING: circular disjoint-sets kernel math math.ranges
   2        sequences sequences.lib ;
   3 IN: project-euler.186
   4
   5 : (generator) ( k -- n )
   6     dup sq 300007 * 200003 - * 100003 + 1000000 rem ;
   7
   8 : <generator> ( -- lag )
   9     55 [1,b] [ (generator) ] map <circular> ;
  10
  11 : advance ( lag -- )
  12     [ { 0 31 } swap nths sum 1000000 rem ] keep push-circular ;
  13
  14 : next ( lag -- n )
  15     [ first ] [ advance ] bi ;
  16
  17 : 2unless? ( x y ?quot quot -- )
  18     >r 2keep rot [ 2drop ] r> if ; inline
  19
  20 : (p186) ( generator counter unionfind -- counter )
  21     524287 over equiv-set-size 990000 <
  22     [
  23         pick [ next ] [ next ] bi
  24         [ = ] [
  25             pick equate
  26             [ 1+ ] dip
  27         ] 2unless? (p186)
  28     ] [
  29         drop nip
  30     ] if ;
  31
  32 : <relation> ( n -- unionfind )
  33     <disjoint-set> [ [ add-atom ] curry each ] keep ;
  34
  35 : euler186 ( -- n )
  36     <generator> 0 1000000 <relation> (p186) ;
  37
  38 MAIN: euler186