#### /extra/project-euler/186/186.factor

http://github.com/abeaumont/factor
Unknown | 76 lines | 55 code | 21 blank | 0 comment | 0 complexity | 4a004a192d1c382fa1bca1f1f6eda1cd MD5 | raw file
``` 1! Copyright (c) 2008 Eric Mertens.
3USING: circular disjoint-sets kernel math math.ranges sequences project-euler.common ;
4IN: 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 circular-push ;
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
76SOLUTION: euler186
```