59 lines
1.5 KiB
Factor
59 lines
1.5 KiB
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
|