Hello I've written the following functions to help me create truth-
tables.
; MAPERM from
; http://cybertiggyr.com/prm/
(defun maperm (fn &rest lists)
(cond ((endp lists) nil)
((endp (rest lists)) (mapc fn (first lists)))
(t (mapc #'(lambda (x)
(apply #'maperm
#'(lambda (&rest args)
(apply fn x args))
(rest lists)))
(first lists))))
(reduce #'* (mapcar #'length lists)))
(defun truth-table (f &optional (desc "") :key (n 2))
(apply #'maperm
(lambda (&rest args)
(format t "~A: ~{~3A~^ ~}:~vT~A~%" desc
args (+ 2 (* n 4)) (apply f args)))
(make-list n :initial-element '(t nil))))
(defun my-and (&rest args) (every #'identity args))
; example use
; (truth-table #'my-and 'AND :n
3)
The output for falsehood is the symbol NIL, thus the computation (+ 2
(* n 4)) to render properly. Is it possible to change how the symbol
NIL is printed, temporarily, without changing its meaning in the
language? I would prefer if it printed "F", to match "T".
This is convenient, but I still have to convert manually expressions
such as
~[x^~y]
To the equivalent LISP one
(truth-table (lambda (x y) (not (and x (not y))))
"material implication")
How should I go about this? Ideally I'd want it to work like:
(truth-table "~[x^~y]" 'and)
It should figure on its own how many variables there are, by treating
every symbol that doesn't belong in the operator set as a variable.
But another way for this to be written would be with a macro,
inventing a syntax similar to the logic one:
(macro (~ (x ^ ~ y)))
This seems less ambiguous and easier to implement.
Ideas/suggestions? Presumably this has been done already by some
project.
Lastly, I also wrote the truth-table function as a macro, using TRACE.
I'm aware of the details of TRACE, and this was not meant to be used,
but only to demonstrate how else this could be written. (it also can't
be used with lambda forms, only symbols that the reader can find a
corresponding function with #'name)
(defmacro my-truth-table (name &optional (n 2))
`(progn
(trace ,name)
(apply #'maperm
#',name
(make-list ,n
:initial-element '(t nil)))
(untrace ,name)))
vippstar <········@gmail.com> writes:
> The output for falsehood is the symbol NIL, thus the computation (+ 2
> (* n 4)) to render properly. Is it possible to change how the symbol
> NIL is printed, temporarily, without changing its meaning in the
> language? I would prefer if it printed "F", to match "T".
This annoys me too. How about using a different canonical true symbol?
“Yes” for true? It would go well with the convention of marking
predicates with “?”. I can't think off the top of my head how many
built-in functions there are that have their hearts set on returning
T. It might be easy to do this without any changes to the environment.
Paul Donnelly wrote:
> vippstar <········@gmail.com> writes:
>
>> The output for falsehood is the symbol NIL, thus the computation (+ 2
>> (* n 4)) to render properly. Is it possible to change how the symbol
>> NIL is printed, temporarily, without changing its meaning in the
>> language? I would prefer if it printed "F", to match "T".
>
> This annoys me too. How about using a different canonical true symbol?
> “Yes” for true? It would go well with the convention of marking
> predicates with “?”. I can't think off the top of my head how many
> built-in functions there are that have their hearts set on returning
> T. It might be easy to do this without any changes to the environment.
If only (setf symbol-name) were valid...
Be careful: the following essentially breaks SBCL and CCL; it
segfaults ECL.
* (symbol-name nil)
* (setf (char * 0) #\F)
* (not t) ;; look at the damage
CLISP continues gracefully; "NIL" is read-only.
- Daniel
vippstar <········@gmail.com> writes:
> Hello I've written the following functions to help me create truth-
> tables.
...
> (defun truth-table (f &optional (desc "") :key (n 2))
> (apply #'maperm
> (lambda (&rest args)
> (format t "~A: ~{~3A~^ ~}:~vT~A~%" desc
> args (+ 2 (* n 4)) (apply f args)))
> (make-list n :initial-element '(t nil))))
...
> The output for falsehood is the symbol NIL, thus the computation (+ 2
> (* n 4)) to render properly. Is it possible to change how the symbol
> NIL is printed, temporarily, without changing its meaning in the
> language? I would prefer if it printed "F", to match "T".
Use some more format directives?
Print the truth value using ~:[F~;T~]
Try this:
(loop for v in '(t nil 3 8 nil)
do (format t "~:[F~;T~] " v))
--
Thomas A. Russ, USC/Information Sciences Institute
···@sevak.isi.edu (Thomas A. Russ) writes:
> vippstar <········@gmail.com> writes:
>
>> Hello I've written the following functions to help me create truth-
>> tables.
> ...
>> (defun truth-table (f &optional (desc "") :key (n 2))
>> (apply #'maperm
>> (lambda (&rest args)
>> (format t "~A: ~{~3A~^ ~}:~vT~A~%" desc
>> args (+ 2 (* n 4)) (apply f args)))
>> (make-list n :initial-element '(t nil))))
> ...
>
>> The output for falsehood is the symbol NIL, thus the computation (+ 2
>> (* n 4)) to render properly. Is it possible to change how the symbol
>> NIL is printed, temporarily, without changing its meaning in the
>> language? I would prefer if it printed "F", to match "T".
>
> Use some more format directives?
>
> Print the truth value using ~:[F~;T~]
>
> Try this:
> (loop for v in '(t nil 3 8 nil)
> do (format t "~:[F~;T~] " v))
I had assumed he was wanting to make return values print nicely. It
seems a silly question if he's writing his own print routines.
···@sevak.isi.edu (Thomas A. Russ) writes:
> vippstar <········@gmail.com> writes:
>
>> Hello I've written the following functions to help me create truth-
>> tables.
> ...
>> (defun truth-table (f &optional (desc "") :key (n 2))
>> (apply #'maperm
>> (lambda (&rest args)
>> (format t "~A: ~{~3A~^ ~}:~vT~A~%" desc
>> args (+ 2 (* n 4)) (apply f args)))
>> (make-list n :initial-element '(t nil))))
> ...
>
>> The output for falsehood is the symbol NIL, thus the computation (+ 2
>> (* n 4)) to render properly. Is it possible to change how the symbol
>> NIL is printed, temporarily, without changing its meaning in the
>> language? I would prefer if it printed "F", to match "T".
>
> Use some more format directives?
>
> Print the truth value using ~:[F~;T~]
>
> Try this:
> (loop for v in '(t nil 3 8 nil)
> do (format t "~:[F~;T~] " v))
(format t "~{~:[F~;T~]~^ ~}~%" '(t nil 3 8 nil))
--
__Pascal Bourguignon__
On Jun 21, 4:43 pm, vippstar <········@gmail.com> wrote:
> Hello I've written the following functions to help me create truth-
> tables.
<snip>
> How should I go about this? Ideally I'd want it to work like:
> (truth-table "~[x^~y]" 'and)
I finally implemented this. I like the result though the code might be
inefficient (and certainly the style isn't very good...). I defined
the language to work with two sets of operators, unary and binary. All
operators are 1 character symbols. I provided the syntactic sugar that
[u]exp, where [u{ is a unary operator becomes [u] exp. (same for [u][u]
exp et cetera).
I provided a macro MAKE-LOGIC-FN which takes a logic expression and
translates it into a lisp function, according to the operators
defined. For instance, (funcall (make-logic-fn (VAR ^ F)) t nil) ==>
nil. WITH-OPS was written to provide a way to introduce new operators
for MAKE-LOGIC-FN to use. WITH-OPS uses MAKE-LOGIC-FN to create lambda
functions. Finally, DOIT wraps it all around the TRUTH-TABLE I
previously wrote. All operators are single-character symbols. To
define new operators, if there's a macro or function that already does
what they do, you can simply (push '(S . foo) *replacements*). If
there is need to define an operator from other logical operators, two
steps must be taken. First (push (cons 'S (gensym)) *replacements*),
then provide the logical definition for 'S in DOIT.
If the operators available are ! (not), ^ (and), v (or), here is how
to add material-implication:
(push (cons '$B"?(B (gensym))
*replacements*)
(doit ((P $B"?(B Q) $B"?(B R)
(($B"?(B . (! (P v !Q))))
'material-implication)
==>
MATERIAL-IMPLICATION: T T: T
MATERIAL-IMPLICATION: T F: F
MATERIAL-IMPLICATION: F T: T
MATERIAL-IMPLICATION: F F: T
4
Below is the code.
; from http://cybertiggyr.com/prm/
(defun maperm (fn &rest lists)
(cond ((endp lists) nil)
((endp (rest lists)) (mapc fn (first lists)))
(t (mapc #'(lambda (x)
(apply #'maperm
#'(lambda (&rest args)
(apply fn x args))
(rest lists)))
(first lists))))
(reduce #'* (mapcar #'length lists)))
(defun truth-table (f &key (n 2) (desc ""))
(apply #'maperm
(lambda (&rest args)
(format t "~A: ~{~:[F~;T~]~^ ~}: ~:[F~;T~]~%" desc
args (apply f args)))
(make-list n :initial-element '(t nil))))
; rest
(defun walk-tree (fn tree)
(mapcar (lambda (x)
(cond ((consp x)
(walk-tree fn x))
(t (funcall fn x))))
(funcall fn tree)))
(defun general-curry (fn f rest)
(lambda (&rest args)
(apply fn (funcall f rest args))))
(defun curry (fn &rest rest)
(general-curry fn #'append
rest))
(defun rcurry (fn &rest rest)
(general-curry fn
(lambda (x y)
(append y x))
rest))
(defun flatten (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
; unary ops MUST be included here
(defparameter *unary-ops* '(!))
; all ops included here.
; CDR must be a macro or function name
(defparameter *replacements*
`((! . not)
(^ . and)
(v . or)
($B"?(B . ,(gensym))))
(defun tokenize (tree list)
(walk-tree (rcurry #'extend-names list)
tree))
(defun extend-names (symbol list)
(if (and (symbolp symbol)
(< 1 (length (symbol-name symbol))))
(let* ((s (symbol-name symbol))
(c (intern (subseq s 0 1))))
(if (member c list)
(list c
(extend-names (intern (subseq s 1))
list))
symbol))
symbol))
(defun transform (x)
(if (consp x)
(case (length x)
(1 (car x))
(2 x)
(3 (list (cadr x)
(car x)
(caddr x))))
x))
(defun extract-vars (logic-sexp)
(remove-duplicates (remove-if (rcurry #'member
(append
'(funcall symbol-function)
(mapcar #'car
*replacements*)))
(flatten logic-sexp))))
(defun parse (sexp)
(let ((sexp (walk-tree #'transform
(tokenize sexp *unary-ops*))))
(values (sublis *replacements* sexp)
(extract-vars sexp))))
(defmacro make-logic-fn (sexp)
(multiple-value-bind (exp args)
(parse sexp)
`(values (lambda ,args ,exp)
',args)))
; final
(defmacro doit (exp &optional (ops) (name))
`(with-ops ,ops
(multiple-value-bind (fn n)
(make-logic-fn ,exp)
(truth-table fn :n (length n)
:desc ,name))))
(defmacro with-ops (ops &body body)
`(labels ,(mapcar (lambda (x)
(cons (cdr (assoc (car x) *replacements*))
(reverse (multiple-value-list
(parse (cdr x))))))
ops)
,@body))
On Jun 23, 6:51 pm, vippstar <········@gmail.com> wrote:
<snip>
> If the operators available are ! (not), ^ (and), v (or), here is how
> to add material-implication:
>
> (push (cons '$B"?(B (gensym))
> *replacements*)
>
> (doit ((P $B"?(B Q) $B"?(B R)
> (($B"?(B . (! (P v !Q))))
> 'material-implication)
That is not material-implication. I should had written . (! (P ^ !Q))