extra/project-euler/032/032.factor

   1 ! Copyright (c) 2008 Aaron Schaefer.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: kernel math math.combinatorics math.functions math.parser
   4 ranges project-euler.common sequences sets ;
   5 IN: project-euler.032
   6
   7 ! https://projecteuler.net/problem=32
   8
   9 ! DESCRIPTION
  10 ! -----------
  11
  12 ! The product 7254 is unusual, as the identity, 39 × 186 = 7254,
  13 ! containing multiplicand, multiplier, and product is 1 through
  14 ! 9 pandigital.
  15
  16 ! Find the sum of all products whose
  17 ! multiplicand/multiplier/product identity can be written as a 1
  18 ! through 9 pandigital.
  19
  20 ! HINT: Some products can be obtained in more than one way so be
  21 ! sure to only include it once in your sum.
  22
  23
  24 ! SOLUTION
  25 ! --------
  26
  27 ! Generate all pandigital numbers and then check if they fit the
  28 ! identity
  29
  30 <PRIVATE
  31
  32 : source-032 ( -- seq )
  33     9 factorial <iota> [
  34         9 <iota> permutation [ 1 + ] map digits>number
  35     ] map ;
  36
  37 : 1and4 ( n -- ? )
  38     number>string 1 cut-slice 4 cut-slice
  39     [ string>number ] tri@ [ * ] dip = ;
  40
  41 : 2and3 ( n -- ? )
  42     number>string 2 cut-slice 3 cut-slice
  43     [ string>number ] tri@ [ * ] dip = ;
  44
  45 : valid? ( n -- ? )
  46     [ 1and4 ] [ 2and3 ] bi or ;
  47
  48 : products ( seq -- m )
  49     [ 10 4 ^ mod ] map ;
  50
  51 PRIVATE>
  52
  53 : euler032 ( -- answer )
  54     source-032 [ valid? ] filter products members sum ;
  55
  56 ! [ euler032 ] 10 ave-time
  57 ! 16361 ms ave run time - 417.8 SD (10 trials)
  58
  59
  60 ! ALTERNATE SOLUTIONS
  61 ! -------------------
  62
  63 ! Generate all reasonable multiplicand/multiplier pairs, then multiply and see
  64 ! if the equation is pandigital
  65
  66 <PRIVATE
  67
  68 ! multiplicand/multiplier/product
  69 : mmp ( x y -- n )
  70     2dup * [ number>string ] tri@ 3append string>number ;
  71
  72 PRIVATE>
  73
  74 : euler032a ( -- answer )
  75     50 [1..b] 2000 [1..b]
  76     [ mmp ] cartesian-map concat
  77     [ pandigital? ] filter
  78     products members sum ;
  79
  80 ! [ euler032a ] 10 ave-time
  81 ! 2624 ms ave run time - 131.91 SD (10 trials)
  82
  83 SOLUTION: euler032a