Update examples paths in README.md

README.md

@@ -92,17 +92,34 @@ metta+>^D   # Exit the REPL with `ctrl-D`.
 
 To run a script:
 ```bash
-mettalog tests/baseline_compat/metta-morph_tests/nalifier.metta
+mettalog exmaples/puzzles/nalifier.metta
 ```
 
 To run a script and then enter the repl:
 ```bash
-mettalog tests/baseline_compat/metta-morph_tests/nalifier.metta --repl
+mettalog exmaples/puzzles//nalifier.metta --repl
+metta+>!(query &self (because blue house keeps parrots the $who is the fish owner))
+[(Succeed ((quote (because blue house keeps parrots the brit is the fish owner))))]
+metta+>
+
 ```
 
-Execute a unit test:
+## Unit tests
+
+One exmaple is provided in this repository
 ```bash
+mettalog --test exmaples/tests/unit_test_example.metta
 # The output is saved as an HTML file in the same directory.
+```
+
+The rest are in a large REPO @
+```bash
+git clone https://github.com/logicmoo/metta-testsuite/
+ln -s metta-testsuite/tests/ ./tests  
+```
+
+Run a single test
+```bash
 mettalog --test tests/baseline_compat/metta-morph_tests/tests0.metta 
 ```
 Execute baseline sanity tests:

examples/puzzles/fish_riddle_1_no_states.metta

@@ -0,0 +1,140 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Backward chaining logic
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Interface for backward chaining (quotes the arguement)
+(: backward-chain (-> Atom Atom Atom Atom Atom))
+(= (backward-chain $info $goal $kb $rb)
+  (backward-chain-q $info (quote $goal) $kb $rb))
+
+;; Handle specific cases during backward chaining
+(: backward-chain-q (-> Atom Atom Atom Atom Atom))
+(= (backward-chain-q $info (quote $goal) $kb $rb)
+	(case (quote $goal) (
+		((quote (is $a $b)) (let $a $b (quote $goal))) ; Assignment
+		((quote (bool $expr)) (if $expr (quote $goal) (empty))) ; Boolean evaluation
+		((quote (eval= $a $expr)) (let $a $expr (quote $goal))) ; Expression evaluation
+		((quote (nonvar $var)) (if (== Variable (get-metatype $var)) (empty) (quote $goal))) ; Non-variable check
+		((quote (var $var)) (if (== Variable (get-metatype $var)) (quote $goal) (empty))) ; Variable check
+		((quote (true)) (quote $goal)) ; Always succeeds
+		((quote (fail)) (empty)) ; Always fails
+		((quote (cut $signal)) (if (equalz $info $signal) (quote $goal) (quote $goal))) ; Cut operator for pruning
+		((quote (naf $expr)) (if (has-match $kb $expr) (empty) (quote $goal))) ; Negation as failure
+		((quote (qnaf $expr)) (let (Failed $_1) (backward-chain $info2 $expr $kb $rb) (quote $goal))) ; Negation as failure at query level
+		($_2 (backward-chain-q2 $info  (quote $goal) $kb $rb)) ; Match against knowledge base
+	)))
+
+(= (backward-chain-q2 $info  (quote $goal) $kb $rb)
+   (match $kb $goal (quote $goal)))
+;; Recursive case for backward chaining
+(= (backward-chain-q2 $old_info  (quote $goal) $kb $rb)
+  (function 
+	(return ;; if $info is bound that means a clause has called a cut (thus we return empty)
+	   (if (== Variable (get-metatype $old_info)) 	 
+		(let $r (match $rb ($goal :- $body)
+		(match-body $info $body $kb $rb $goal))
+			 (if (== Variable (get-metatype $info)) ;; if not cut
+				$r                                  ;; then return normal
+				(return $r)))                       ;; else return early
+		(empty)))))
+
+
+;; Match predicate: checks if a goal has at least one match in a space
+;; This is less efficient, as it processes the entire space to find matches
+(: has-match (-> Atom Atom Bool))
+(= (has-match $space $g)
+	(let $m (collapse (match $space $g True)) ; Attempt to match $g in $space
+		(if (== $m ()) ; If no match is found
+			False ; Return False
+			True ; Otherwise, return True
+		)
+	)
+)
+
+;; Predicate to check if a function definition exists in a given space
+(= (has-fundef $space $g)
+	(let $m (collapse (match $space (= $g $_1) True)) ; Match $g as a function in $space
+		(if (== $m ()) ; If no match is found
+			False ; Return False
+			True ; Otherwise, return True
+		)
+	)
+)
+
+;; Chain through each element in the body and return the goal
+(: match-body (-> Atom Atom Atom Atom Atom Atom))
+(= (match-body $info $body $kb $rb $goal)
+	(if (== $body ())
+		(quote $goal) ; Base case: no more elements to match
+		(let* (
+			(($cur $rest) (decons-atom $body)) ; Deconstruct body
+			($debugging False) ;; Print debug or not
+			($bugcheck False)  ;; Catch a bug where we dont return the quoted goals
+			(() (if $debugging (println! (quote (IN (cur= $cur) (goal= $goal)))) ())) ; Debugging: log input
+			($_12 (if $bugcheck
+				  (let*  (($retVal (backward-chain $info $cur $kb $rb)) ; Recursive chaining
+						  ($m (collapse (equalz (quote $cur) $retVal))) ; Check match
+						  (() (if (== $m ()) (println! (quote (BAD!!!!!!!! (cur= $cur) (retVal= $retVal))) ())))
+						  ) ()) ()))
+			((quote $cur) (backward-chain $info $cur $kb $rb)) ; Recursive chaining
+			(() (if $debugging (println! (quote (OUT (cur= $cur) (goal= $goal)))) ())) ; Debugging: log output
+			) 
+			(match-body $info $rest $kb $rb $goal) ; Continue matching
+		)
+	)
+)
+
+
+;; Predicate for general atom equality
+(: equalz (-> Atom Atom Bool)) ; Compares two atoms
+(= (equalz $A $A) True) ; Atoms are equal if they are identical
+
+;!(equalz $a (+ 1 1))
+
+;; Query execution logic
+(: query (-> Atom Atom Atom))
+(= (query $kb $goal)
+	(let $m (collapse (backward-chain $info $goal $kb  $kb))
+		(if (== $m ()) (Failed (quote $goal)) (Succeed $m))) 
+)
+
+
+;; Predicate: Check if an element is a member of a list
+(member $Elem ($Cons $Elem $_1)) ; Base case: element found
+((member $Elem ($Cons $_1 $Tail)) :-
+ ((member $Elem $Tail))) ; Recursive case: continue checking
+
+;; Predicate to check equality of two values
+(same $x $x)
+
+((because $color house keeps $other the $nationality is the $type owner) :- 
+  ((same $Houses
+			(Cons ( 1 $_1 $_2 $_3 $_4 $_5) ; First house
+			(Cons ( 2 $_6 $_7 $_8 $_9 $_10) ; Second house
+			 $Open)))
+
+	(same $Open Nil)
+
+	; Clue 1: The Norwegian lives in the first house
+	(member ( 1 norwegian $_11 $_12 $_13 $_14) $Houses)
+	; Clue 2: The Brit lives in the red house
+	(member ( $_15 brit red $_16 $_17 $_18) $Houses)
+	; Clue 3: The owner of the blue house drinks tea
+	(member ( $_19 $_20 blue tea $_21 $_22) $Houses)
+	; Clue 4: The owner of the red house keeps $other
+	(member ( $_23 $_24 $color $_25 $other $_26) $Houses)
+	; Clue 5: The owner of the tea-drinking house smokes Prince
+	(member ( $_27 $_28 $_29 tea $_30 prince) $Houses)
+	; Determine the $nationality of owns the $type
+	(member ( $_31 $nationality $_32 $_33 $type $_34) $Houses)))
+
+;;;;;;;;;;;;;;;;;;
+;; TEST Queries ;;
+;;;;;;;;;;;;;;;;;;
+
+!(query &self (because red house keeps dogs the $norwegian is the fish owner))
+
+!(query &self (because blue house keeps dogs the $brit is the fish owner))
+
+!(query &self (because red house keeps cats the $norwegian is the fish owner))
+

examples/puzzles/nalifier.metta

@@ -0,0 +1,120 @@
+(: If (-> Bool Atom Atom))
+(= (If True $then) $then)
+(= (If False $then) (let $x 0 (let $x 1 $x)))
+
+(: If (-> Bool Atom Atom Atom))
+(= (If $cond $then $else) (if $cond $then $else))
+
+(: sequential (-> Expression %Undefined%))
+(= (sequential $1) (superpose $1))
+
+(: do (-> Expression %Undefined%))
+(= (do $1) (case $1 ()))
+
+(= (max $1 $2) (if (> $1 $2) $1 $2))
+(= (min $1 $2) (if (< $1 $2) $1 $2))
+(= (abs $x) (If (< $x 0) (- 0 $x) $x))
+
+(= (TupleConcat $Ev1 $Ev2) (collapse (superpose ((superpose $Ev1) (superpose $Ev2)))))
+
+;; Truth functions
+(= (Truth_c2w $c) (/ $c (- 1 $c)))
+(= (Truth_w2c $w) (/ $w (+ $w 1)))
+(= (Truth_Deduction ($f1 $c1) ($f2 $c2)) ((* $f1 $f2) (* (* $f1 $f2) (* $c1 $c2))))
+(= (Truth_Abduction ($f1 $c1) ($f2 $c2)) ($f2 (Truth_w2c (* (* $f1 $c1) $c2))))
+(= (Truth_Induction $T1 $T2) (Truth_Abduction $T2 $T1))
+(= (Truth_Revision ($f1 $c1) ($f2 $c2))
+   (let* (($w1 (Truth_c2w $c1)) ($w2 (Truth_c2w $c2)) ($w  (+ $w1 $w2))
+          ($f (/ (+ (* $w1 $f1) (* $w2 $f2)) $w)) ($c (Truth_w2c $w)))
+          ((min 1.00 $f) (min 0.99 (max (max $c $c1) $c2)))))
+(= (Truth_Expectation ($f $c)) (+ (* $c (- $f 0.5)) 0.5))
+
+;;NAL-1
+;;!Syllogistic rules for Inheritance:
+(= (|- ($T $T1) ($T $T2)) ($T (Truth_Revision $T1 $T2)))
+(= (|- (($a --> $b) $T1) (($b --> $c) $T2)) (($a --> $c) (Truth_Deduction $T1 $T2)))
+(= (|- (($a --> $b) $T1) (($a --> $c) $T2)) (($c --> $b) (Truth_Induction $T1 $T2)))
+(= (|- (($a --> $c) $T1) (($b --> $c) $T2)) (($b --> $a) (Truth_Abduction $T1 $T2)))
+
+;Whether evidence was just counted once
+(= (StampDisjoint $Ev1 $Ev2)
+   (== () (collapse (let* (($x (superpose $Ev1))
+                           ($y (superpose $Ev2)))
+                          (case (== $x $y) ((True overlap)))))))
+
+;actually that is quite cool and 4x faster in MeTTa than below (yet still 130 times slower than metta-morph with below)
+;but it depends on more advanced pattern matching features which are not yet in metta-morph
+;(= (query $Term)
+;   (match &self (, (= (|- ($A $T1) ($B $T2)) ($Term ($f $T1 $T2)))
+;                   (($A $T1) $Ev1) (($B $T2) $Ev2))
+;          (If (StampDisjoint $Ev1 $Ev2)
+;              (($Term ($f $T1 $T2)) (TupleConcat $Ev1 $Ev2)))))
+
+(= (query $Term)
+   (match &self (, (($A $T1) $Ev1) (($B $T2) $Ev2))
+          (let ($TermNew $T) (|- ($A $T1) ($B $T2))
+               (If (and (== $TermNew $Term) (StampDisjoint $Ev1 $Ev2))
+                   (($Term $T) (TupleConcat $Ev1 $Ev2))))))
+
+;choice between two options of different term
+(= (Choice (($Term1 $T1) $ev1) (($Term2 $T2) $ev2))
+   (If (> (Truth_Expectation $T1) (Truth_Expectation $T2))
+       (($Term1 $T1) $ev1)
+       (($Term2 $T2) $ev2)))
+
+;revise if there is no evidential overlap, else use higher-confident candidate
+(= (RevisionAndChoice (($Term1 ($f1 $c1)) $ev1) (($Term2 ($f2 $c2)) $ev2))
+   (let $ConclusionStamp (TupleConcat $ev1 $ev2)
+        (If (StampDisjoint $ev1 $ev2)
+            (($Term2 (Truth_Revision ($f1 $c1) ($f2 $c2))) $ConclusionStamp)
+            (If (> $c1 $c2)
+                (($Term1 ($f1 $c1)) $ev1)
+                (($Term2 ($f2 $c2)) $ev2)))))
+
+;reduce beliefs
+(= (reduceBeliefs $revChoiceOrBoth $option $options)
+   (If (== $options ())
+       $option
+       (let* (($head (car-atom $options))
+              ($rest (cdr-atom $options))
+              ($revi ($revChoiceOrBoth $option $head)))
+             (reduceBeliefs $revChoiceOrBoth $revi $rest))))
+
+;an empty event for reduction purposes
+(= (EmptyEvent todo) ((x (1.0 0.0)) ()))
+
+;evidence query tries to maximize evidence for the passed statement term
+(= (evidenceQuery $Term) (reduceBeliefs RevisionAndChoice (EmptyEvent todo) (collapse (query $Term))))
+
+;choice query picks the option of highest truth expectation among the options of different term
+(= (choiceQuery $Terms)
+   (let $options (collapse (evidenceQuery (superpose $Terms)))
+        (reduceBeliefs Choice (EmptyEvent todo) $options)))
+
+
+
+(((dog --> (IntSet brown)) (1.0 0.9)) (1))
+(((dog --> (IntSet small)) (1.0 0.9)) (2))
+(((dog --> (IntSet furry)) (1.0 0.9)) (3))
+(((dog --> (IntSet barks)) (1.0 0.9)) (4))
+
+(((duck --> (IntSet yellow)) (1.0 0.9)) (5))
+(((duck --> (IntSet small)) (1.0 0.9)) (6))
+(((duck --> (IntSet feathered)) (1.0 0.9)) (7))
+(((duck --> (IntSet quacks)) (1.0 0.9)) (8))
+
+(((swan --> (IntSet white)) (1.0 0.9)) (9))
+(((swan --> (IntSet big)) (1.0 0.9)) (10))
+(((swan --> (IntSet feathered)) (1.0 0.9)) (11))
+
+((((ExtSet sam) --> (IntSet white)) (1.0 0.9)) (12))
+((((ExtSet sam) --> (IntSet small)) (1.0 0.9)) (13))
+((((ExtSet sam) --> (IntSet quacks)) (1.0 0.9)) (14))
+
+!(let ($S $EV) (choiceQuery (((ExtSet sam) --> duck)
+                             ((ExtSet sam) --> swan)
+                             ((ExtSet sam) --> dog)))
+      $S)
+
+
+;  !(repl!)