|
| 1 | +!(import! &self (library lib_import)) |
| 2 | +!(use-module! heaps) |
| 3 | +!(import_prolog_function (superpose (empty_heap add_to_heap get_from_heap heap_size))) |
| 4 | + |
1 | 5 | (= (clamp $v $min $max) |
2 | 6 | (min $max (max $v $min))) |
3 | 7 |
|
|
84 | 88 | ; (Unique $rest $Ret) |
85 | 89 | ; (Unique $rest (TupleConcat ($x) $Ret)))))) |
86 | 90 |
|
| 91 | +;;Incremental tuple dedup helpers. |
| 92 | +(= (PushUnique $L $x) |
| 93 | + (if (ElementOf $x $L) |
| 94 | + $L |
| 95 | + (cons $x $L))) |
| 96 | + |
| 97 | +(= (ConcatUnique $base $items) |
| 98 | + (if (== $items ()) |
| 99 | + $base |
| 100 | + (let* (($head (car-atom $items)) |
| 101 | + ($tail (cdr-atom $items))) |
| 102 | + (ConcatUnique (PushUnique $base $head) $tail)))) |
| 103 | + |
87 | 104 | ;; Consistency Conditions: PLN book "5.2.2.2 PLN Deduction and Second-Order Probability", page 74: |
88 | 105 |
|
89 | 106 | ; borrowed from https://github.com/trueagi-io/hyperon-pln/blob/main/metta/pln/dependent-types/DeductionDTL.metta |
|
377 | 394 |
|
378 | 395 | ;;Whether evidence was just counted once |
379 | 396 | (= (StampDisjoint $Ev1 $Ev2) |
380 | | - (== () (collapse (let* (($x (superpose $Ev1)) |
381 | | - ($y (superpose $Ev2))) |
382 | | - (case (== $x $y) ((True True))))))) |
| 397 | + (if (== $Ev1 ()) |
| 398 | + True |
| 399 | + (let* (($x (car-atom $Ev1)) |
| 400 | + ($rest (cdr-atom $Ev1))) |
| 401 | + (if (ElementOf $x $Ev2) |
| 402 | + False |
| 403 | + (StampDisjoint $rest $Ev2))))) |
383 | 404 |
|
384 | 405 | ;;Concat stamp with sorting |
385 | 406 | (= (StampConcat $stamp $addition) |
|
402 | 423 | (= (PriorityRank (Sentence ($x (stv $f $c)) $Ev1)) $c) |
403 | 424 | (= (PriorityRank ()) -99999.0) |
404 | 425 |
|
405 | | -;;candidate elimination based on negated priority |
406 | | -(= (PriorityRankNeg (Sentence ($x (stv $f $c)) $Ev1)) (- 0.0 $c)) |
407 | | -(= (PriorityRankNeg ()) -99999.0) |
| 426 | +;;task heap helpers (highest confidence first, via negative key) |
| 427 | +(= (TaskHeapPush $heap $item) |
| 428 | + (let $prio (PriorityRank $item) |
| 429 | + (add_to_heap $heap (- 0 $prio) $item))) |
| 430 | + |
| 431 | +(= (TaskHeapFromTuple $tuple) |
| 432 | + (foldl-atom $tuple (empty_heap) TaskHeapPush)) |
| 433 | + |
| 434 | +(= (HeapTakeItems $heap $n $acc) |
| 435 | + (if (or (<= $n 0) (== (heap_size $heap) 0)) |
| 436 | + $acc |
| 437 | + (let* (($rest (get_from_heap $heap $_priority $item))) |
| 438 | + (HeapTakeItems $rest (- $n 1) (cons $item $acc))))) |
408 | 439 |
|
409 | 440 | ;;Return limited-sized version of $L (bounded PQ functionality) |
410 | 441 | (= (LimitSize $L $size) |
411 | | - (if (< (TupleCount $L) $size) |
| 442 | + (if (<= (TupleCount $L) $size) |
412 | 443 | $L |
413 | | - (let $lowestPriorityItem (BestCandidate PriorityRankNeg () $L) |
414 | | - (LimitSize (Without $L $lowestPriorityItem) $size)))) |
| 444 | + (HeapTakeItems (TaskHeapFromTuple $L) $size ()))) |
415 | 445 |
|
416 | 446 | ;;Priority-queue based task ranking deriver with belief buffer |
417 | 447 | (= (PLN.Derive $Tasks $Beliefs $steps $maxsteps $taskqueuesize $beliefqueuesize) |
418 | 448 | (if (or (> $steps $maxsteps) (== $Tasks ())) |
419 | 449 | ($Tasks $Beliefs) |
420 | | - (let (Sentence $x $Ev1) (BestCandidate PriorityRank () $Tasks) |
421 | | - (let $derivations |
422 | | - (collapse (superpose ((let* (((Sentence $y $Ev2) (superpose $Beliefs)) |
423 | | - ($stamp (InsertionSort (TupleConcat $Ev1 $Ev2) ()))) |
424 | | - (if (StampDisjoint $Ev1 $Ev2) |
425 | | - (case (superpose ((|- $x $y) |
426 | | - (|- $y $x))) |
427 | | - ((($T $TV) (Sentence ($T $TV) $stamp)))) |
428 | | - (empty))) |
429 | | - (case (|- $x) ((($T3 $TV3) (Sentence ($T3 $TV3) $Ev1))))))) |
430 | | - (let $temp (trace! (SELECTED $steps (Sentence $x $Ev1)) 42) |
431 | | - (PLN.Derive (LimitSize (Without (Unique (TupleConcat $Tasks $derivations) ()) (Sentence $x $Ev1)) $taskqueuesize) |
432 | | - (LimitSize (Unique (TupleConcat $Beliefs $derivations) ()) $beliefqueuesize) |
433 | | - (+ $steps 1) |
434 | | - $maxsteps |
435 | | - $taskqueuesize |
436 | | - $beliefqueuesize)))))) |
| 450 | + (let (Sentence $x $Ev1) (BestCandidate PriorityRank () $Tasks) |
| 451 | + (let $derivations |
| 452 | + (collapse (superpose ((let* (((Sentence $y $Ev2) (superpose $Beliefs))) |
| 453 | + (if (StampDisjoint $Ev1 $Ev2) |
| 454 | + (let $stamp (InsertionSort (TupleConcat $Ev1 $Ev2) ()) |
| 455 | + (superpose ((case (|- $x $y) |
| 456 | + ((($Txy $TVxy) (Sentence ($Txy $TVxy) $stamp)))) |
| 457 | + (case (|- $y $x) |
| 458 | + ((($Tyx $TVyx) (Sentence ($Tyx $TVyx) $stamp))))))) |
| 459 | + (empty))) |
| 460 | + (case (|- $x) ((($T3 $TV3) (Sentence ($T3 $TV3) $Ev1))))))) |
| 461 | + (PLN.Derive (LimitSize (Without (ConcatUnique $Tasks $derivations) (Sentence $x $Ev1)) $taskqueuesize) |
| 462 | + (LimitSize (ConcatUnique $Beliefs $derivations) $beliefqueuesize) |
| 463 | + (+ $steps 1) |
| 464 | + $maxsteps |
| 465 | + $taskqueuesize |
| 466 | + $beliefqueuesize))))) |
437 | 467 |
|
438 | 468 | (= (PLN.Derive $Tasks $Beliefs $maxsteps $taskqueuesize $beliefqueuesize) |
439 | 469 | (PLN.Derive $Tasks $Beliefs 1 $maxsteps $taskqueuesize $beliefqueuesize)) |
|
448 | 478 | (= (ConfidenceRank ((stv $f $c) $Ev)) $c) |
449 | 479 | (= (ConfidenceRank ()) 0) |
450 | 480 |
|
| 481 | +(= (ConfidenceHeapPush $heap $item) |
| 482 | + (let $prio (ConfidenceRank $item) |
| 483 | + (add_to_heap $heap (- 0 $prio) $item))) |
| 484 | + |
| 485 | +(= (ConfidenceHeapFromTuple $tuple) |
| 486 | + (foldl-atom $tuple (empty_heap) ConfidenceHeapPush)) |
| 487 | + |
| 488 | +(= (BestConfidenceCandidate $tuple) |
| 489 | + (if (== $tuple ()) |
| 490 | + () |
| 491 | + (let $_rest (get_from_heap (ConfidenceHeapFromTuple $tuple) $_priority $item) |
| 492 | + $item))) |
| 493 | + |
451 | 494 | ;;Pose a question of a certain term to the system on some knowledge base |
452 | 495 | (= (PLN.Query $Tasks $Beliefs $term $maxsteps $taskqueuesize $beliefqueuesize) |
453 | | - (BestCandidate ConfidenceRank () (collapse (let ($TasksRet $BeliefsRet) (PLN.Derive $Tasks $Beliefs $maxsteps $taskqueuesize $beliefqueuesize) |
454 | | - (case (superpose $BeliefsRet) |
455 | | - (((Sentence ($Term $TV) $Ev) (case (== $Term $term) |
456 | | - ((True ($TV $Ev))))))))))) |
| 496 | + (BestConfidenceCandidate |
| 497 | + (collapse (let ($TasksRet $BeliefsRet) (PLN.Derive $Tasks $Beliefs $maxsteps $taskqueuesize $beliefqueuesize) |
| 498 | + (case (superpose $BeliefsRet) |
| 499 | + (((Sentence ($Term $TV) $Ev) (case (== $Term $term) |
| 500 | + ((True ($TV $Ev))))))))))) |
457 | 501 |
|
458 | 502 | (= (PLN.Query $kb $term $maxsteps $taskqueuesize $beliefqueuesize) |
459 | 503 | (PLN.Query $kb $kb $term $maxsteps $taskqueuesize $beliefqueuesize)) |
|
463 | 507 |
|
464 | 508 | (= (PLN.Query $kb $term) |
465 | 509 | (PLN.Query $kb $term (PLN.Config.MaxSteps))) ;default steps bound |
466 | | - |
|
0 commit comments