extra/project-euler/265/265.factor

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