extra/logic/logic-tests.factor

   1 ! Copyright (C) 2019-2020 KUSUMOTO Norio.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: tools.test logic lists assocs math kernel namespaces
   4 accessors sequences
   5 logic.examples.factorial
   6 logic.examples.fib
   7 logic.examples.fib2
   8 logic.examples.hanoi
   9 logic.examples.hanoi2
  10 logic.examples.money
  11 logic.examples.zebra
  12 logic.examples.zebra2 ;
  13
  14 IN: logic.tests
  15
  16 LOGIC-PREDS: cato mouseo creatureo ;
  17 LOGIC-VARS: X Y ;
  18 SYMBOLS: Tom Jerry Nibbles ;
  19 { cato Tom } fact
  20 { mouseo Jerry } fact
  21 { mouseo Nibbles } fact
  22
  23 { t } [ { cato Tom } query ] unit-test
  24 { f } [ { { cato Tom } { cato Jerry } } query ] unit-test
  25 { { H{ { X Jerry } } H{ { X Nibbles } } } } [
  26     { mouseo X } query
  27 ] unit-test
  28
  29 { creatureo X } { cato X } rule
  30
  31 { { H{ { Y Tom } } } } [ { creatureo Y } query ] unit-test
  32
  33 LOGIC-PREDS: youngo young-mouseo ;
  34 { youngo Nibbles } fact
  35 { young-mouseo X } {
  36     { mouseo X }
  37     { youngo X }
  38 } rule
  39
  40 { { H{ { X Nibbles } } } } [ { young-mouseo X } query ] unit-test
  41
  42 { creatureo X } { mouseo X } rule
  43
  44 { { H{ { X Tom } } H{ { X Jerry } } H{ { X Nibbles } } } } [
  45     { creatureo X } query
  46 ] unit-test
  47
  48 creatureo clear-pred
  49 { creatureo Y } {
  50     { cato Y } ;; { mouseo Y }
  51 } rule
  52 { "cato" } [
  53     creatureo get defs>> first second first pred>> name>>
  54 ] unit-test
  55 { "mouseo" } [
  56     creatureo get defs>> second second first pred>> name>>
  57 ] unit-test
  58
  59 creatureo clear-pred
  60 { creatureo Y } {
  61     { cato Y } ;; { mouseo Y }
  62 } rule*
  63 { "cato" } [
  64     creatureo get defs>> first second first pred>> name>>
  65 ] unit-test
  66 { "mouseo" } [
  67     creatureo get defs>> second second first pred>> name>>
  68 ] unit-test
  69
  70 { { H{ { X Tom } } H{ { X Jerry } } H{ { X Nibbles } } } } [
  71     { creatureo X } query
  72 ] unit-test
  73
  74 { { H{ { Y Tom } } H{ { Y Jerry } } } } [
  75     { creatureo Y } 2 nquery
  76 ] unit-test
  77
  78 SYMBOL: Spike
  79 LOGIC-PREDS: dogo ;
  80 { dogo Spike } fact
  81 creatureo clear-pred
  82 { creatureo X } { dogo X } rule
  83 { creatureo Y } {
  84     { cato Y } ;; { mouseo Y }
  85 } rule
  86 { "dogo" } [
  87     creatureo get defs>> first second first pred>> name>>
  88 ] unit-test
  89 { "cato" } [
  90     creatureo get defs>> second second first pred>> name>>
  91 ] unit-test
  92 { "mouseo" } [
  93     creatureo get defs>> third second first pred>> name>>
  94 ] unit-test
  95
  96 creatureo clear-pred
  97 { creatureo X } { dogo X } rule
  98 { creatureo Y } {
  99     { cato Y } ;; { mouseo Y }
 100 } rule*
 101 { "cato" } [
 102     creatureo get defs>> first second first pred>> name>>
 103 ] unit-test
 104 { "mouseo" } [
 105     creatureo get defs>> second second first pred>> name>>
 106 ] unit-test
 107 { "dogo" } [
 108     creatureo get defs>> third second first pred>> name>>
 109 ] unit-test
 110
 111 creatureo clear-pred
 112 { creatureo Y } {
 113     { cato Y } ;; { mouseo Y }
 114 } rule
 115
 116 LOGIC-PREDS: likes-cheeseo dislikes-cheeseo ;
 117 { likes-cheeseo X } { mouseo X } rule
 118 { dislikes-cheeseo Y } {
 119     { creatureo Y }
 120     \+ { likes-cheeseo Y }
 121 } rule
 122
 123 { f } [ { dislikes-cheeseo Jerry } query ] unit-test
 124 { t } [ { dislikes-cheeseo Tom } query ] unit-test
 125
 126 { L{ Tom Jerry Nibbles } } [ L{ Tom Jerry Nibbles } ] unit-test
 127 { t } [ { membero Jerry L{ Tom Jerry Nibbles } } query ] unit-test
 128
 129 { f } [
 130     { membero Spike [ Tom Jerry Nibbles L{ } cons cons cons ] } query
 131 ] unit-test
 132
 133 TUPLE: house living dining kitchen in-the-wall ;
 134 LOGIC-PREDS: houseo ;
 135 { houseo T{ house
 136             { living Tom }
 137             { dining f }
 138             { kitchen Nibbles }
 139             { in-the-wall Jerry }
 140           }
 141 } fact
 142
 143 { { H{ { X Nibbles } } } } [
 144     { houseo T{ house
 145                 { living __ }
 146                 { dining __ }
 147                 { kitchen X }
 148                 { in-the-wall __ }
 149               }
 150     } query
 151 ] unit-test
 152
 153 LOGIC-PREDS: is-ao consumeso ;
 154 SYMBOLS: mouse cat milk cheese fresh-milk Emmentaler ;
 155 {
 156     { is-ao Tom cat }
 157     { is-ao Jerry mouse }
 158     { is-ao Nibbles mouse }
 159     { is-ao fresh-milk milk }
 160     { is-ao Emmentaler cheese }
 161 } facts
 162 {
 163     {
 164         { consumeso X milk } {
 165             { is-ao X mouse } ;;
 166             { is-ao X cat }
 167         }
 168     }
 169     { { consumeso X cheese } { is-ao X mouse } }
 170     { { consumeso Tom mouse } { !! f } }
 171     { { consumeso X mouse } { is-ao X cat } }
 172 } rules
 173
 174 {
 175     {
 176         H{ { X milk } { Y fresh-milk } }
 177         H{ { X cheese } { Y Emmentaler } }
 178     }
 179 } [
 180     { { consumeso Jerry X } { is-ao Y X } } query
 181 ] unit-test
 182 { { H{ { X milk } { Y fresh-milk } } } } [
 183     { { consumeso Tom X } { is-ao Y X } } query
 184 ] unit-test
 185
 186 SYMBOL: a-cat
 187 { is-ao a-cat cat } fact
 188 { {
 189         H{ { X milk } { Y fresh-milk } }
 190         H{ { X mouse } { Y Jerry } }
 191         H{ { X mouse } { Y Nibbles } }
 192     }
 193 } [
 194     { { consumeso a-cat X } { is-ao Y X } } query
 195 ] unit-test
 196
 197 cato clear-pred
 198 mouseo clear-pred
 199 { f } [ { creatureo X } query ] unit-test
 200
 201 { cato Tom } fact
 202 { mouseo Jerry } fact
 203 { mouseo Nibbles } fact*
 204 { { H{ { Y Nibbles } } H{ { Y Jerry } } } } [
 205     { mouseo Y } query
 206 ] unit-test
 207
 208 { mouseo Jerry } retract
 209 { { H{ { X Nibbles } } } } [
 210     { mouseo X } query
 211 ] unit-test
 212
 213 { mouseo Jerry } fact
 214 { { H{ { X Nibbles } } H{ { X Jerry } } } } [
 215     { mouseo X } query
 216 ] unit-test
 217 { mouseo __ } retract-all
 218 { f } [ { mouseo X } query ] unit-test
 219
 220 { { mouseo Jerry } { mouseo Nibbles } } facts
 221 SYMBOLS: big small a-big-cat a-small-cat ;
 222 { cato big a-big-cat } fact
 223 { cato small a-small-cat } fact
 224 { { H{ { X Tom } } } } [ { cato X } query ] unit-test
 225 {
 226     {
 227        H{ { X big } { Y a-big-cat } }
 228        H{ { X small } { Y a-small-cat } }
 229     }
 230 } [ { cato X Y } query ] unit-test
 231 {
 232     { H{ { X Tom } } H{ { X Jerry } } H{ { X Nibbles } } }
 233 } [ { creatureo X } query ] unit-test
 234
 235 { cato __ __ } retract-all
 236 { f } [ { cato X Y } query ] unit-test
 237 { { H{ { X Tom } } } } [ { cato X } query ] unit-test
 238
 239 LOGIC-PREDS: factorialo N_>_0  N2_is_N_-_1  F_is_F2_*_N ;
 240 LOGIC-VARS: N N2 F F2 ;
 241 { factorialo 0 1 } fact
 242 { factorialo N F } {
 243     { N_>_0 N }
 244     { N2_is_N_-_1 N2 N }
 245     { factorialo N2 F2 }
 246     { F_is_F2_*_N F F2 N }
 247 } rule
 248 { N_>_0 N } [ N of 0 > ] callback
 249 {
 250     { { N2_is_N_-_1 N2 N } [ dup N of 1 - N2 unify ] }
 251     { { F_is_F2_*_N F F2 N } [ dup [ N of ] [ F2 of ] bi * F unify ] }
 252 } callbacks
 253
 254 { { H{ { F 1 } } } } [ { factorialo 0 F } query ] unit-test
 255 { { H{ { F 1 } } } } [ { factorialo 1 F } query ] unit-test
 256 { { H{ { F 3628800 } } } } [ { factorialo 10 F } query ] unit-test
 257
 258 factorialo clear-pred
 259 { factorialo 0 1 } fact
 260 { factorialo N F } {
 261     { (>) N 0 }
 262     [ [ N of 1 - ] N2 is ]
 263     { factorialo N2 F2 }
 264     [ [ [ F2 of ] [ N of ] bi * ] F is ]
 265 } rule
 266
 267 { { H{ { F 1 } } } } [ { factorialo 0 F } query ] unit-test
 268 { { H{ { F 1 } } } } [ { factorialo 1 F } query ] unit-test
 269 { { H{ { F 3628800 } } } } [ { factorialo 10 F } query ] unit-test