extra/logic/examples/money/money.factor

   1 ! Copyright (C) 2019-2020 KUSUMOTO Norio.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: logic lists assocs sequences kernel math
   4 locals formatting io ;
   5 IN: logic.examples.money
   6
   7 LOGIC-PREDS: sumo sum1o digitsumo delo donaldo moneyo ;
   8 LOGIC-VARS: S E N D M O R Y A L G B T
   9             N1 N2 C C1 C2 D1 D2 L1
  10             Digits Digs Digs1 Digs2 Digs3 ;
  11
  12 { sumo N1 N2 N } {
  13     { sum1o N1 N2 N 0 0 L{ 0 1 2 3 4 5 6 7 8 9 } __ }
  14 } rule
  15
  16 { sum1o L{ } L{ } L{ } 0 0 Digits Digits } fact
  17 { sum1o L{ D1 . N1 } L{ D2 . N2 } L{ D . N } C1 C Digs1 Digs } {
  18     { sum1o N1 N2 N C1 C2 Digs1 Digs2 }
  19     { digitsumo D1 D2 C2 D C Digs2 Digs }
  20 } rule
  21
  22 { digitsumo D1 D2 C1 D C Digs1 Digs } {
  23     { delo D1 Digs1 Digs2 }
  24     { delo D2 Digs2 Digs3 }
  25     { delo D Digs3 Digs }
  26     [ [ [ D1 of ] [ D2 of ] [ C1 of ] tri + + ] S is ]
  27     [ [ S of 10 mod ] D is ]
  28     [ [ S of 10 /i ] C is ]
  29 } rule
  30
  31 { delo A L L } { { nonvaro A } !! } rule
  32 { delo A L{ A . L } L } fact
  33 { delo A L{ B . L } L{ B . L1 } } { delo A L L1 } rule
  34
  35 { moneyo
  36   L{ 0 S E N D }
  37   L{ 0 M O R E }
  38   L{ M O N E Y }
  39 } fact
  40
  41 { donaldo
  42   L{ D O N A L D }
  43   L{ G E R A L D }
  44   L{ R O B E R T }
  45 } fact
  46
  47 :: S-and-M-can't-be-zero ( seq -- seq' )
  48     seq [| hash |
  49          1 hash N1 of list>array nth 0 = not
  50          1 hash N2 of list>array nth 0 = not and
  51     ] filter ;
  52
  53 :: print-puzzle ( hash-array -- )
  54     hash-array
  55     [| hash |
  56      "   " printf hash N1 of list>array [ "%d " printf ] each nl
  57      "+  " printf hash N2 of list>array [ "%d " printf ] each nl
  58      "----------------" printf nl
  59      "   " printf hash N  of list>array [ "%d " printf ] each nl nl
  60     ] each ;