extra/project-euler/186/186.factor

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