extra/project-euler/265/265.factor

   1 ! Copyright (c) 2010 Samuel Tardieu.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: generalizations kernel math math.functions project-euler.common
   4 sequences sets ;
   5 IN: project-euler.265
   6
   7 ! http://projecteuler.net/index.php?section=problems&id=265
   8
   9 ! 2^(N) binary digits can be placed in a circle so that all the N-digit
  10 ! clockwise subsequences are distinct.
  11
  12 ! For N=3, two such circular arrangements are possible, ignoring rotations.
  13
  14 ! For the first arrangement, the 3-digit subsequences, in clockwise order, are:
  15 ! 000, 001, 010, 101, 011, 111, 110 and 100.
  16
  17 ! Each circular arrangement can be encoded as a number by concatenating
  18 ! the binary digits starting with the subsequence of all zeros as the most
  19 ! significant bits and proceeding clockwise. The two arrangements for N=3 are
  20 ! thus represented as 23 and 29:
  21 ! 00010111 _(2) = 23
  22 ! 00011101 _(2) = 29
  23
  24 ! Calling S(N) the sum of the unique numeric representations, we can see that S(3) = 23 + 29 = 52.
  25
  26 ! Find S(5).
  27
  28 CONSTANT: N 5
  29
  30 : decompose ( n -- seq )
  31     N iota [ drop [ 2/ ] [ 1 bitand ] bi ] map nip reverse ;
  32
  33 : bits ( seq -- n )
  34     0 [ [ 2 * ] [ + ] bi* ] reduce ;
  35
  36 : complete ( seq -- seq' )
  37     unclip decompose append [ 1 bitand ] map ;
  38
  39 : rotate-bits ( seq -- seq' )
  40     dup length iota [ cut prepend bits ] with map ;
  41
  42 : ?register ( acc seq -- )
  43     complete rotate-bits
  44     dup [ 2 N ^ mod ] map all-unique? [ infimum swap push ] [ 2drop ] if ;
  45
  46 : add-bit ( seen bit -- seen' t/f )
  47     over last 2 * + 2 N ^ mod
  48     2dup swap member? [ drop f ] [ suffix t ] if ;
  49
  50 : iterate ( acc left seen -- )
  51     over 0 = [
  52         nip ?register
  53     ] [
  54         [ 1 - ] dip
  55         { 0 1 } [ add-bit [ iterate ] [ 3drop ] if ] 3 nwith each
  56     ] if ;
  57
  58 : euler265 ( -- answer )
  59     V{ } clone [ 2 N ^ N - { 0 } iterate ] [ sum ] bi ;
  60
  61 ! [ euler265 ] time
  62 ! Running time: 0.376389019 seconds
  63
  64 SOLUTION: euler265