changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/q/tests/suite.lisp

changeset 698: 96958d3eb5b0
parent: 7ce855f76e1d
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; tests.lisp --- Q Tests
     2 
     3 ;; 
     4 
     5 ;;; Code:
     6 (in-package :q/tests)
     7 
     8 (defsuite :q)
     9 
    10 (in-suite :q)
    11 
    12 (deftest sanity ()
    13   (is (make-instance 'query-engine
    14         :parser (make-instance 'query-parser)
    15         :optimizer (make-instance 'sql-optimizer)
    16         :sources nil)))
    17 
    18 (deftest sql-select ()
    19   (setf (gethash "FOO" tbl) (make-df nil))
    20   (with-sql (expr "SELECT I FROM FOO")
    21     (is (typep expr 'sql-select))
    22     (let ((tbl (make-hash-table :test 'equalp)))
    23       (is (gethash "FOO" tbl))
    24       (make-sql-data-frame expr tbl))))
    25 
    26 (deftest sql-math ()
    27   (with-sql (expr "1 + 2 * 3")
    28     (is (typep expr 'sql-math-expression))
    29     (is (typep (rhs expr) 'sql-math-expression))
    30     (is (typep (lhs expr) 'sql-number))))
    31 
    32 ;; https://www.cpp.edu/~jrfisher/www/prolog_tutorial/2_1.html
    33 (deftest dql (:skip t)
    34   (adjacent 1 2)
    35   (adjacent 2 1) 
    36   (adjacent 1 3)
    37   (adjacent 3 1) 
    38   (adjacent 1 4)
    39   (adjacent 4 1) 
    40   (adjacent 1 5)
    41   (adjacent 5 1) 
    42   (adjacent 2 3)
    43   (adjacent 3 2) 
    44   (adjacent 2 4)
    45   (adjacent 4 2) 
    46   (adjacent 3 4)
    47   (adjacent 4 3) 
    48   (adjacent 4 5)
    49   (adjacent 5 4) 
    50   (color 1 red a)
    51   (color 1 red b) 
    52   (color 2 blue a)
    53   (color 2 blue b) 
    54   (color 3 green a)
    55   (color 3 green b) 
    56   (color 4 yellow a)
    57   (color 4 blue b) 
    58   (color 5 blue a)
    59   (color 5 green b))
    60 
    61 #| SL
    62 Exercise 2.9. Translate to clausal logic:
    63 (a) every mouse has a tail;
    64 (b) somebody loves everybody;
    65 (c) every two numbers have a maximum.
    66 |#
    67 (deftest dql-clausal-simple (:skip t))
    68 
    69 ;; ref: https://en.wikipedia.org/wiki/Zebra_Puzzle
    70 
    71 ;; ref: https://franz.com/support/documentation/11.0/prolog.html
    72 (deftest dql-zebra ()
    73   "A solution for the Zebra problem using DQL."
    74   (<-- (nextto ?x ?y ?list) (iright ?x ?y ?list))
    75   (<-  (nextto ?x ?y ?list) (iright ?y ?x ?list))
    76   (<-- (iright ?left ?right (?left ?right . ?rest)))
    77   (<-  (iright ?left ?right (?x . ?rest))
    78        (iright ?left ?right ?rest))
    79   (<-- (zebra ?h ?w ?z)
    80        ;; Each house is of the form:
    81        ;; (house nationality pet cigarette drink house-color)
    82        (= ?h ((house norwegian ? ? ? ?)   ;1,10
    83               ?
    84               (house ? ? ? milk ?) ? ?))  ; 9
    85        (member (house englishman ? ? ? red) ?h) ; 2
    86        (member (house spaniard dog ? ? ?) ?h) ; 3
    87        (member (house ? ? ? coffee green) ?h) ; 4
    88        (member (house ukrainian ? ? tea ?) ?h) ; 5
    89        (iright (house ? ? ? ? ivory)      ; 6
    90                (house ? ? ? ? green) ?h)
    91        (member (house ? snails winston ? ?) ?h) ; 7
    92        (member (house ? ? kools ? yellow) ?h) ; 8
    93        (nextto (house ? ? chesterfield ? ?) ;11
    94                (house ? fox ? ? ?) ?h)
    95        (nextto (house ? ? kools ? ?)      ;12
    96                (house ? horse ? ? ?) ?h)
    97        (member (house ? ? luckystrike oj ?) ?h) ;13
    98        (member (house japanese ? parliaments ? ?) ?h) ;14
    99        (nextto (house norwegian ? ? ? ?)  ;15
   100                (house ? ? ? ? blue) ?h)
   101        (member (house ?w ? ? water ?) ?h) ;Q1
   102        (member (house ?z zebra ? ? ?) ?h)) ;Q2
   103   ;; execute the query
   104   (?- (zebra ?houses ?water-drinker ?zebra-owner))
   105   ;; It is believed that solving zebra a
   106   ;; single time requires 12825 inferences.
   107   )