extra/project-euler/186/186.factor

   1 ! Copyright (c) 2008 Eric Mertens.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: circular disjoint-sets kernel math math.ranges sequences project-euler.common ;
   4 IN: project-euler.186
   5
   6 ! http://projecteuler.net/index.php?section=problems&id=186
   7
   8 ! DESCRIPTION
   9 ! -----------
  10
  11 ! Here are the records from a busy telephone system with one million users:
  12
  13 !     RecNr  Caller  Called
  14 !     1      200007  100053
  15 !     2      600183  500439
  16 !     3      600863  701497
  17 !     ...    ...     ...
  18
  19 ! The telephone number of the caller and the called number in record n are
  20 ! Caller(n) = S2n-1 and Called(n) = S2n where S1,2,3,... come from the "Lagged
  21 ! Fibonacci Generator":
  22
  23 ! For 1 <= k <= 55, Sk = [100003 - 200003k + 300007k^3] (modulo 1000000)
  24 ! For 56 <= k, Sk = [Sk-24 + Sk-55] (modulo 1000000)
  25
  26 ! If Caller(n) = Called(n) then the user is assumed to have misdialled and the
  27 ! call fails; otherwise the call is successful.
  28
  29 ! From the start of the records, we say that any pair of users X and Y are
  30 ! friends if X calls Y or vice-versa. Similarly, X is a friend of a friend of Z
  31 ! if X is a friend of Y and Y is a friend of Z; and so on for longer chains.
  32
  33 ! The Prime Minister's phone number is 524287. After how many successful calls,
  34 ! not counting misdials, will 99% of the users (including the PM) be a friend,
  35 ! or a friend of a friend etc., of the Prime Minister?
  36
  37
  38 ! SOLUTION
  39 ! --------
  40
  41 : (generator) ( k -- n )
  42     dup sq 300007 * 200003 - * 100003 + 1000000 rem ;
  43
  44 : <generator> ( -- lag )
  45     55 [1,b] [ (generator) ] map <circular> ;
  46
  47 : advance ( lag -- )
  48     [ { 0 31 } swap nths sum 1000000 rem ] keep push-circular ;
  49
  50 : next ( lag -- n )
  51     [ first ] [ advance ] bi ;
  52
  53 : 2unless? ( x y ?quot quot -- )
  54     [ 2keep rot [ 2drop ] ] dip if ; inline
  55
  56 : (p186) ( generator counter unionfind -- counter )
  57     524287 over equiv-set-size 990000 < [
  58         pick [ next ] [ next ] bi
  59         [ = ] [
  60             pick equate
  61             [ 1+ ] dip
  62         ] 2unless? (p186)
  63     ] [
  64         drop nip
  65     ] if ;
  66
  67 : <relation> ( n -- unionfind )
  68     <disjoint-set> [ [ add-atom ] curry each ] keep ;
  69
  70 : euler186 ( -- n )
  71     <generator> 0 1000000 <relation> (p186) ;
  72
  73 ! [ euler186 ] 10 ave-time
  74 ! 18572 ms ave run time - 796.87 SD (10 trials)
  75
  76 SOLUTION: euler186