Truth table: Difference between revisions
added Factor
(Added C) |
(added Factor) |
||
Line 881:
1 1 1 0 1
1 1 1 1 0
</pre>
=={{header|Factor}}==
Postfix is a natural choice. That way, we can use <code>(eval)</code> to to evaluate the expressions without much fuss.
<lang factor>USING: arrays combinators eval formatting io kernel listener
math.combinatorics prettyprint qw sequences splitting
vocabs.parser ;
IN: rosetta-code.truth-table
: prompt ( -- str )
"Please enter a boolean expression using 1-long" print
"variable names and postfix notation. Available" print
"operators are and, or, not, and xor. Example:" print
"> a b and" print nl
"> " write readln nl ;
: replace-var ( str -- str' )
dup length 1 = [ drop "%s" ] when ;
: replace-vars ( str -- str' )
" " split [ replace-var ] map " " join ;
: extract-vars ( str -- seq )
" " split [ length 1 = ] filter ;
: count-vars ( str -- n )
" " split [ "%s" = ] count ;
: truth-table ( n -- seq )
qw{ t f } swap selections ;
: print-row ( seq -- )
[ write bl ] each ;
: print-table ( seq -- )
[ print-row nl ] each ;
! Adds a column to the end of a two-dimensional array.
: add-col ( seq col -- seq' )
[ flip ] dip 1array append flip ;
: header ( str -- )
[ extract-vars ] [ ] bi
[ print-row "| " write ] [ print ] bi*
"=================" print ;
: solve-expr ( seq str -- ? )
vsprintf [ "kernel" use-vocab ( -- x ) (eval) ]
with-interactive-vocabs ;
: results ( str -- seq )
replace-vars dup count-vars truth-table
[ swap solve-expr unparse ] with map ;
: main ( -- )
prompt
[ header t ]
[ replace-vars count-vars truth-table ]
[ results [ "| " prepend ] map ] tri
add-col print-table drop ;
MAIN: main</lang>
{{out}}
<pre>
Please enter a boolean expression using 1-long
variable names and postfix notation. Available
operators are and, or, not, and xor. Example:
> a b and
> a b or
a b | a b or
=================
t t | t
t f | t
f t | t
f f | f
Please enter a boolean expression using 1-long
variable names and postfix notation. Available
operators are and, or, not, and xor. Example:
> a b and
> x y and z xor not
x y z | x y and z xor not
=================
t t t | t
t t f | f
t f t | f
t f f | t
f t t | f
f t f | t
f f t | f
f f f | t
</pre>
| |||