aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Truth-table/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Truth_table

19
Task/Truth-table/00-TASK.txt Normal file
View file

@ -0,0 +1,19 @@
A [[wp:Truth table|truth table]] is a display of the inputs to, and the output of a Boolean function organized as a table where each row gives one combination of input values and the corresponding value of the function.
;Task:
# Input a Boolean function from the user as a string then calculate and print a formatted truth table for the given function.<br> (One can assume that the user input is correct).
# Print and show output for Boolean functions of two and three input variables, but any program should not be limited to that many variables in the function.
# Either reverse-polish or infix notation expressions are allowed.
;Related tasks:
* &nbsp; [[Boolean values]]
* &nbsp; [[Ternary logic]]
;See also:
* &nbsp; [http://mathworld.wolfram.com/TruthTable.html Wolfram MathWorld entry on truth tables].
* &nbsp; [http://www.google.co.uk/search?q=truth+table&hl=en&client=firefox-a&hs=Om7&rls=org.mozilla:en-GB:official&prmd=imvns&tbm=isch&tbo=u&source=univ&sa=X&ei=C0uuTtjuH4Wt8gOF4dmYCw&ved=0CDUQsAQ&biw=941&bih=931&sei=%20Jk-uTuKKD4Sg8QOFkPGcCw some "truth table" examples from Google].
<br><br>

139
Task/Truth-table/11l/truth-table.11l Normal file
View file

@ -0,0 +1,139 @@
T Symbol
String id
Int lbp
Int nud_bp
Int led_bp
(ASTNode -> ASTNode) nud
((ASTNode, ASTNode) -> ASTNode) led
F set_nud_bp(nud_bp, nud)
.nud_bp = nud_bp
.nud = nud
F set_led_bp(led_bp, led)
.led_bp = led_bp
.led = led
T Var
String name
Int value
F (name)
.name = name
[Var] vars
T ASTNode
Symbol& symbol
Int var_index
ASTNode? first_child
ASTNode? second_child
F eval()
S .symbol.id
‘(var)’
R :vars[.var_index].value
‘|’
R .first_child.eval() [|] .second_child.eval()
‘^’
R .first_child.eval() (+) .second_child.eval()
‘&’
R .first_child.eval() [&] .second_child.eval()
‘!’
R (-).first_child.eval() [&] 1
‘(’
R .first_child.eval()
E
assert(0B)
R 0
[String = Symbol] symbol_table
[String] tokens
V tokeni = -1
ASTNode token_node
F advance(sid = ‘’)
I sid != ‘’
assert(:token_node.symbol.id == sid)
:tokeni++
:token_node = ASTNode()
I :tokeni == :tokens.len
:token_node.symbol = :symbol_table[‘(end)’]
R
V token = :tokens[:tokeni]
I token[0].is_alpha()
:token_node.symbol = :symbol_table[‘(var)’]
L(v) :vars
I v.name == token
:token_node.var_index = L.index
L.break
L.was_no_break
:token_node.var_index = :vars.len
:vars.append(Var(token))
E
:token_node.symbol = :symbol_table[token]
F expression(rbp = 0)
ASTNode t = move(:token_node)
advance()
V left = t.symbol.nud(move(t))
L rbp < :token_node.symbol.lbp
t = move(:token_node)
advance()
left = t.symbol.led(t, move(left))
R left
F parse(expr_str) -> ASTNode
:tokens = re:‘\s*(\w+|.)’.find_strings(expr_str)
:tokeni = -1
:vars.clear()
advance()
R expression()
F symbol(id, bp = 0) -> &
I id !C :symbol_table
V s = Symbol()
s.id = id
s.lbp = bp
:symbol_table[id] = s
R :symbol_table[id]
F infix(id, bp)
F led(ASTNode self, ASTNode left)
self.first_child = left
self.second_child = expression(self.symbol.led_bp)
R self
symbol(id, bp).set_led_bp(bp, led)
F prefix(id, bp)
F nud(ASTNode self)
self.first_child = expression(self.symbol.nud_bp)
R self
symbol(id).set_nud_bp(bp, nud)
infix(‘|’, 1)
infix(‘^’, 2)
infix(‘&’, 3)
prefix(‘!’, 4)
F nud(ASTNode self)
R self
symbol(‘(var)’).nud = nud
symbol(‘(end)’)
F nud_parens(ASTNode self)
V expr = expression()
advance(‘)’)
R expr
symbol(‘(’).nud = nud_parens
symbol(‘)’)
L(expr_str) [‘!A | B’, ‘A ^ B’, ‘S | ( T ^ U )’, ‘A ^ (B ^ (C ^ D))’]
print(‘Boolean expression: ’expr_str)
print()
ASTNode p = parse(expr_str)
print(vars.map(v -> v.name).join(‘ ’)‘ : ’expr_str)
L(i) 0 .< (1 << vars.len)
L(v) vars
v.value = (i >> (vars.len - 1 - L.index)) [&] 1
print(v.value, end' ‘ ’)
print(‘: ’p.eval())
print()

379
Task/Truth-table/8080-Assembly/truth-table.8080 Normal file
View file

@ -0,0 +1,379 @@
;;; CP/M truth table generator
;;; Supported operators:
;;; ~ (not), & (and), | (or), ^ (xor) and => (implies)
;;; Variables are A-Z, constants are 0 and 1.
putch: equ 2
puts: equ 9
TVAR: equ 32
TCONST: equ 64
TOP: equ 96
TPAR: equ 128
TMASK: equ 31
TTYPE: equ 224
org 100h
lxi h,80h ; Have we got a command line argument?
mov a,m
ana a
lxi d,noarg ; If not, print error message and stop.
mvi c,puts
jz 5
add l ; Otherwise, 0-terminate the argument string
inr a
mov l,a
mvi m,0
inx h
mvi m,'$' ; And $-terminate it also for error messages
lxi h,opstk ; Pointer to operator stack on the system stack
push h
lxi h,80h ; Start of command line
lxi b,expr ; Start of expression (output queue for shunting yard)
parse: inx h
mvi a,' ' ; Ignore all whitespace
cmp m
jz parse
mov a,m ; Load current character
ana a ; Done?
jz pdone
mov d,a ; Store copy in D
ori 32 ; Check for variable
sui 'a'
cpi 26
jnc pconst ; If not variable, go check constants
ori TVAR ; It _is_ a variable
stax b ; Store token
inx b
jmp parse ; Next token
pconst: mov a,d ; Restore character
sui '0' ; 0 or 1 are constants
cpi 2
jnc pparen ; If not constant, go check parenthesis
ori TCONST ; It _is_ a constant
stax b ; Store token
inx b
jmp parse
pparen: mov a,d ; Restore character
sui '(' ; ( and ) are parentheses
jz ppopen ; Open parenthesis
dcr a
jnz poper ; If not ( or ), check operators
xthl ; Closing parenthesis - get operator stack
closep: mov a,l ; If at beginning, missing ( - give error
ana a
jz emiss
dcx h ; Back up pointer
mov a,m ; Found it?
cpi TPAR
jnz closes ; If not, keep scanning
xthl ; Get input string back
jmp parse ; Keep parsing
closes: stax b ; Not parenthesis - put token in output queue
inx b
jmp closep ; And keep going
ppopen: xthl ; Get operator stack
mvi m,TPAR ; Store open parenthesis
inx h
xthl ; Get input string
jmp parse
poper: push h ; Check tokens - keep input string
mvi e,0 ; Counter
lxi h,opers ; Operator pointer
opscan: mov a,m ; Check against character
cmp d ; Found it?
jz opfind
inr e ; Increment counter
ana a ; Otherwise, is it zero?
inx h
jnz opscan ; If not, keep scanning
eparse: lxi d,pserr ; It is zero - print a parse error
mvi c,puts
call 5
pop d
mvi c,puts
call 5
rst 0
opfind: cpi '=' ; Special case - is it '='?
jnz opfin2 ; If so it should be followed by '>'
xthl
inx h
mov a,m
xthl
cpi '>'
jnz eparse ; '=' not part of '=>' is parse error
opfin2: mvi d,0 ; Look up the precedence for this operator
lxi h,prec
dad d
mov d,m ; Store it in D (D=prec E=operator number)
pop h ; Restore input string
xthl ; Get operator stack pointer
oppop: mov a,l ; At beginning of operator stack?
ana a
jz oppush ; Then done - push current operator
dcx h ; Check what's on top
mov a,m
inx h
cpi TPAR ; Parenthesis?
jz oppush ; Then done - push current operator
push b ; Store output pointer for a while
push h ; As well as operator stack pointer
mvi b,0 ; Get index of operator from stack
ani TMASK
mov c,a
lxi h,prec ; Find precedence
dad b
mov a,m ; Load precedence into A
pop h ; Restore operator stack pointer
pop b ; As well as output pointer
cmp d ; Compare to operator from input
jc oppush ; If input precedence higher, then push operator
dcx h ; Otherwise, pop from operator stack,
mov a,m
stax b ; And store in output queue
inx b
jmp oppop ; Keep popping from operator stack
oppush: mov a,e ; Get input operator
ori TOP
mov m,a ; Store on operator stack
inx h
xthl ; Switch to input string
jmp parse
emiss: lxi d,missp ; Error message for missing parentheses
mvi c,puts
call 5
rst 0
pdone: pop h ; Get operator stack pointer
ppop: mov a,l ; Pop whatever is left off
ana a
jz cntvar
dcx h
mov a,m ; Get value
cpi TPAR ; If we find a paranthesis then the parentheses
jz emiss ; don't match
stax b ; Store in output queue
inx b
jmp ppop
cntvar: stax b ; Zero-terminate the expression
lxi h,vused+25 ; See which variables are used in the expr
xra a
vzero: mov m,a
dcr l
jp vzero
lxi d,expr
vscan: ldax d ; Load expression element
inx d ; Next one next time
ana a ; Was it zero?
jz vdone ; Then we're done
mov b,a ; Store copy
ani TTYPE ; Is it a variable?
cpi TVAR
jnz vscan ; If not, ignore it
mov a,b
ani TMASK
mov l,a ; If so, mark it
inr m
jmp vscan
vdone: call eval ; Run the evaluation once to catch errors
lxi h,vused ; Print header
mvi b,0 ; Character counter
varhdr: mov a,m ; Current variable used?
ana a
jz varnxt ; If not, skip it
inr b ; Two characters
inr b
push h ; Keep registers
push b
mvi c,putch ; Print letter
mov a,l
adi 'A'
mov e,a
call 5
mvi c,putch ; Print space
mvi e,' '
call 5
pop b ; Restore registers
pop h
varnxt: inr l
mov a,l
cpi 26
jnz varhdr
inr b ; Two characters for "| "
inr b
push b
lxi d,dvdr
mvi c,puts
call 5
pop b
lxi h,81h ; Print expression
exhdr: inr b ; One character
push b
push h
mov e,m
mvi c,putch
call 5
pop h
pop b
mov a,m ; Until zero reached
ana a
inx h
jnz exhdr
push b ; Keep count
lxi d,nwln ; Print newline
mvi c,puts
call 5
pop b
linhdr: push b ; Print dashes
mvi c,putch
mvi e,'-'
call 5
pop b
dcr b
jnz linhdr
lxi h,vars ; Set all variables to 0
xra a
zero: mov m,a
inr l
jnz zero
mloop: lxi d,nwln ; Print newline
mvi c,puts
call 5
lxi h,vars ; Print current state
lxi d,vused
lxi b,1A00h
pstate: ldax d ; Is variable in use?
ana a
jz pnext ; If not, try next one
mov c,e ; Keep highest used variable
mov a,m ; Otherwise, get value
ani 1 ; 0 or 1
ori '0'
push b ; Keep state
push d
push h
mvi c,putch ; Print variable
mov e,a
call 5
mvi c,putch ; And space
mvi e,' '
call 5
pop h ; Restore state
pop d
pop b
pnext: inx h ; Print next one
inx d
dcr b
jnz pstate
push b ; Keep last variable
lxi d,dvdr ; Print "| "
mvi c,puts
call 5
call eval ; Evaluate expr using current state
ani 1 ; Print result
ori '0'
mvi c,putch
mov e,a
call 5
pop b ; Restore last used variable
inr c
lxi h,vars ; Find next state
lxi d,vused
istate: ldax d ; Is variable in use?
ana a
jz inext ; If not, try next one
mov a,m ; Otherwise, get value
ana a ; Is it zero?
jnz iinc ; If not, keep going,
inr m ; But if so, set it to one
jmp mloop ; And print next state
iinc: dcr m ; If one, set it to zero
inext: inx d ; And try next variable
inx h
dcr c ; Test if we have variables left
jnz istate ; If not, try next one
rst 0 ; But if so, we're done
eval: lxi b,expr ; Evaluate the expression
lxi h,opstk ; Evaluation stack
eloop: ldax b ; Load expression element
inx b
ana a ; Done?
jz edone
mov d,a ; Keep copy
ani TTYPE
cpi TCONST ; Constant?
jz econst
cpi TVAR ; Variable?
jz evar
mov a,d ; Otherwise it's an operator
ani TMASK
mov d,a
ana a ; Not?
jnz e2
dcr l ; Error if stack empty
jm errop
mov a,m ; Not
cma
mov m,a
inr l
jmp eloop
e2: dcr l ; 2 values needed - error if stack empty
mov e,m ; Right hand value
dcr l
mov a,m ; Left hand value
jm errop
dcr d ; And?
jz eand
dcr d ; Or?
jz eor
dcr d ; Xor?
jz exor
eimpl: ana a ; Implies - if A=1 then E else 1
jnz e_lde
mvi m,-1
inr l
jmp eloop
e_lde: mov m,e
inr l
jmp eloop
exor: xra e
jmp estore
eor: ora e
jmp estore
eand: ana e
estore: mov m,a
inr l
jmp eloop
econst: mov a,d ; Constant
ani TMASK
mov m,a
inr l
jmp eloop
evar: mov a,d ; Variable
ani TMASK
push h
mvi h,vars/256
mov l,a
mov a,m
pop h
mov m,a
inr l
jmp eloop
edone: dcr l ; Should be at 0
mov a,m
rz
lxi d,mop ; Missing operator (not all values used)
jmp errop+3
errop: lxi d,mval ; Missing operand (stack underflow)
mvi c,puts
call 5
rst 0
nwln: db 13,10,'$'
dvdr: db '| $'
noarg: db 'Please enter a boolean expression on the command line.$'
missp: db 'Missing parenthesis.$'
pserr: db 'Parse error at: $'
mval: db 'Missing operand.$'
mop: db 'Missing operator.$'
opers: db '~&|^=',0 ; Operators - note that impl is actually =>
prec: db 4,3,2,2,1 ; Precedence
opstk: equ ($/256)*256+256 ; Operator stack (for shunting yard)
vars: equ opstk+256 ; Space for variables
vused: equ vars+256 ; Marks which variables are used
expr: equ vused+26 ; Parsed expression is stored here

82
Task/Truth-table/ALGOL-68/truth-table.alg Normal file
View file

@ -0,0 +1,82 @@
# prints the truth table of a boolean expression composed of the 26 lowercase variables a..z, #
# the boolean operators AND, OR, XOR and NOT and the literal values TRUE and FALSE #
# The evaluation is done with the Algol 68G evaluate function which is an extension #
PROC print truth table = ( STRING expr )VOID:
BEGIN
# recursively prints the truth table #
PROC print line = ( INT v )VOID:
IF v > UPB bv
THEN
# at the end of the variables - print the line #
FOR e TO UPB bv DO
IF used[ e ] THEN print( ( " ", bv[ e ], " " ) ) FI
OD;
print( ( " ", evaluate( expr ), newline ) )
ELIF used[ v ]
THEN
# have another variable #
bv[ v ] := TRUE;
print line( v + 1 );
bv[ v ] := FALSE;
print line( v + 1 )
ELSE
# this variable is not used #
print line( v + 1 )
FI # print line # ;
# returns the name of the variable number #
PROC variable name = ( INT number )CHAR: REPR ( number + ( ABS "a" - 1 ) );
# the 26 boolean variables #
BOOL a := FALSE, b := FALSE, c := FALSE, d := FALSE, e := FALSE, f := FALSE;
BOOL g := FALSE, h := FALSE, i := FALSE, j := FALSE, k := FALSE, l := FALSE;
BOOL m := FALSE, n := FALSE, o := FALSE, p := FALSE, q := FALSE, r := FALSE;
BOOL s := FALSE, t := FALSE, u := FALSE, v := FALSE, w := FALSE, x := FALSE;
BOOL y := FALSE, z := FALSE;
# table of the variables allowng access by number #
[]REF BOOL bv = ( a, b, c, d, e, f, g, h, i, j, k, l, m
, n, o, p, q, r, s, t, u, v, w, x, y, z
);
[ 26 ]BOOL used;
BOOL at least one variable := FALSE;
# determine which variables are used in the expression #
FOR v TO UPB bv DO
used[ v ] := char in string( variable name( v ), NIL, expr );
IF used[ v ]THEN at least one variable := TRUE FI
OD;
# print truth table headings #
print( ( expr, ":", newline ) );
FOR v TO UPB bv DO
IF used[ v ] THEN print( ( " ", variable name( v ), " " ) ) FI
OD;
print( ( " value", newline ) );
FOR v TO UPB bv DO
IF used[ v ] THEN print( ( " - " ) ) FI
OD;
print( ( " -----", newline ) );
# evaluate the expression for each cobination of variables #
IF at least one variable
THEN
# the expression does not consist of literals only #
FOR v TO UPB bv DO bv[ v ] := FALSE OD;
print line( LWB bv )
ELSE
# the expression is constant #
print( ( " ", evaluate( expr ), newline ) )
FI
END # print truth table # ;
# print truth tables from the user's expressions #
print( ( "Please enter Boolean expressions using variables a, b, c, ..., z,", newline ) );
print( ( "operators AND, OR, NOT and XOR and literals TRUE and FALSE", newline ) );
print( ( "(Note operators and TRUE/FALSE must be uppercase and variables must be lower case)", newline ) );
print( ( "Enter a blank line to quit", newline ) );
WHILE
STRING expr;
print( ( "expression> " ) );
read( ( expr, newline ) );
expr /= ""
DO
print truth table( expr )
OD

45
Task/Truth-table/APL/truth-table.apl Normal file
View file

@ -0,0 +1,45 @@
truth←{
op←⍉↑'~∧∨≠→('(4 3 2 2 1 0)
order←⍬⍬{
out stk←⍺
0=≢⍵:out,⌽stk
c rst←(⊃⍵) (1↓⍵)
c∊⎕A:((out,c)stk)∇rst
c∊'01':((out,⍎c)stk)∇rst
(c≠'(')∧(≢op)≥n←op[;1]⍳c:rst∇⍨out{
cnd←⌽∧\⌽(⍵≠'(')∧op[op[;1]⍳⍵;2]≥op[n;2]
(⍺,⌽cnd/⍵)(((~cnd)/⍵),c)
}stk
c='(':(out(stk,c))∇rst
c=')':rst∇⍨out{
⍬≡par←⍸'('=⍵:'Missing ('⎕SIGNAL 11
n←⌈/par
(⍺,n↓⍵)((n-1)↑⍵)
}stk
('Invalid character ',c)⎕SIGNAL 11
}1(819⌶)⍵~4↑⎕TC
'('∊order:'Missing )'⎕SIGNAL 11
nvar←≢vars←∪(order∊⎕A)/order
eval←{
⍺←⍬
0=≢⍵:{
1≠≢⍵:'Missing operator'⎕SIGNAL 11 ⋄ ⊃⍵
}⍺
c rst←(⊃⍵) (1↓⍵)
c∊⎕A:(⍺⍺[vars⍳c],⍺)∇rst
c∊0 1:(c,⍺)∇rst
c='~':(⍺≠1 0↑⍨≢⍺)∇rst ⊣ 'Missing operand'⎕SIGNAL(0=≢⍺)/11
c∊op[;1]:({
2>≢⍵:'Missing operand'⎕SIGNAL 11
c='→':(≥/2↑⍵),2↓⍵
((⍎c)/2↑⍵),2↓⍵
}⍺)∇rst
}
_←(nvar/0) eval order
confs←⍉(nvar/2)⊤¯1+⍳2*nvar
tab←'FT│'[1+(confs,2),{⍵ eval order}¨↓confs]
tab←↑,/ ' ',¨tab
hdr←((∊,/(' ',¨vars),' '),[0.5]'─'),⍪'│┼'
hdr←hdr,(' ',⍵,' '),[0.5]'─'
hdr⍪(,∘' '⍣(⊃⊃-/1↓¨⍴¨hdr tab))tab
}

70
Task/Truth-table/BASIC/truth-table.basic Normal file
View file

@ -0,0 +1,70 @@
10 DEFINT A-Z: DATA "~",4,"&",3,"|",2,"^",2,"=>",1
20 DIM V(26),E(255),S(255),C(5),C$(5)
30 FOR I=1 TO 5: READ C$(I),C(I): NEXT
40 PRINT "Boolean expression evaluator"
50 PRINT "----------------------------"
60 PRINT "Operators are: ~ (not), & (and), | (or), ^ (xor), => (implies)."
70 PRINT "Variables are A-Z. Constant False and True are 0 and 1."
100 FOR I=1 TO 26: V(I)=0: NEXT
110 PRINT: LINE INPUT "Enter an expression: ";A$
120 E$="": E=0: S=0
130 FOR I=1 TO LEN(A$)
140 I$=MID$(A$,I,1)
150 IF I$<>" " THEN E$=E$+I$
160 NEXT
170 IF E$="" THEN END ELSE Y$=E$
180 IF E$="" THEN 330
190 A$=LEFT$(E$,1): A=ASC(A$) OR 32: B$=RIGHT$(E$,LEN(E$)-1)
200 IF A>=97 AND A<=122 THEN E(E)=A-33: E=E+1: E$=B$: GOTO 180
210 IF A$="0" OR A$="1" THEN E(E)=VAL(A$)+32: E=E+1: E$=B$: GOTO 180
220 IF A$="(" THEN S(S)=97: S=S+1: E$=B$: GOTO 180
225 IF A$=")" THEN E$=B$: GOTO 300
227 I=1
230 IF LEFT$(E$,LEN(C$(I)))=C$(I) THEN 250 ELSE I=I+1: IF I<6 THEN 230
240 PRINT "Parse error at: ";E$: PRINT: GOTO 100
250 A$=C$(I): E$=RIGHT$(E$,LEN(E$)-LEN(A$))
260 IF I=1 THEN S(S)=1: S=S+1: GOTO 180
270 IF S=0 THEN 290
275 IF S(S-1)<>97 AND C(S(S-1) AND 31)>=C(I) THEN 280 ELSE 290
280 S=S-1: E(E)=S(S): E=E+1: GOTO 270
290 S(S)=I: S=S+1: GOTO 180
300 IF S=0 THEN PRINT "Error: missing (!": GOTO 100
310 IF S(S-1)<>97 THEN S=S-1: E(E)=S(S): E=E+1: GOTO 300
320 S=S-1: GOTO 180
330 IF S=0 THEN 350 ELSE S=S-1
335 IF S(S)=97 THEN PRINT "Error: missing )!": GOTO 100
340 E(E)=S(S): E=E+1: GOTO 330
350 V$=""
360 FOR I=0 TO E-1
370 IF (E(I) AND 224)<>64 THEN 390
380 A$=CHR$(E(I)+1): IF INSTR(V$,A$)=0 THEN V$=V$+A$
390 NEXT
400 GOSUB 600
410 FOR I=1 TO LEN(V$): PRINT MID$(V$,I,1);" ";: NEXT
420 PRINT "| ";Y$
430 PRINT STRING$(2+2*LEN(V$)+LEN(Y$),"-")
440 FOR J=1 TO 2^LEN(V$)
450 FOR I=1 TO LEN(V$)
460 IF V(I) THEN PRINT "T "; ELSE PRINT "F ";
470 NEXT
480 PRINT "| ";: GOSUB 600: IF S(0) THEN PRINT "T" ELSE PRINT "F"
490 I=1
500 IF V(I) THEN V(I)=0: I=I+1: GOTO 500 ELSE V(I)=1
510 NEXT
520 GOTO 100
600 S=0
610 FOR I=0 TO E-1: T=E(I) AND 224: V=E(I) AND 31
620 IF T=0 THEN ON V GOTO 700,710,720,730,740
630 IF T=32 THEN S(S)=-V: S=S+1: GOTO 650
640 IF T=64 THEN S(S)=V(INSTR(V$,CHR$(V+65))): S=S+1: GOTO 650
650 NEXT
660 IF S<>1 THEN PRINT "Missing operator": GOTO 100
670 RETURN
700 IF S<1 THEN 770 ELSE S(S-1)=1-S(S-1): GOTO 650
710 IF S<2 THEN 770 ELSE S=S-1:S(S-1)=S(S-1) AND S(S): GOTO 650
720 IF S<2 THEN 770 ELSE S=S-1:S(S-1)=S(S-1) OR S(S): GOTO 650
730 IF S<2 THEN 770 ELSE S=S-1:S(S-1)=S(S-1) XOR S(S): GOTO 650
740 IF S<2 THEN 770 ELSE S=S-1
750 IF S(S-1) THEN S(S-1)=S(S) ELSE S(S-1)=-1
760 GOTO 650
770 PRINT "Missing operand": GOTO 100

135
Task/Truth-table/C++/truth-table.cpp Normal file
View file

@ -0,0 +1,135 @@
#include <iostream>
#include <stack>
#include <string>
#include <sstream>
#include <vector>
struct var {
char name;
bool value;
};
std::vector<var> vars;
template<typename T>
T pop(std::stack<T> &s) {
auto v = s.top();
s.pop();
return v;
}
bool is_operator(char c) {
return c == '&' || c == '|' || c == '!' || c == '^';
}
bool eval_expr(const std::string &expr) {
std::stack<bool> sob;
for (auto e : expr) {
if (e == 'T') {
sob.push(true);
} else if (e == 'F') {
sob.push(false);
} else {
auto it = std::find_if(vars.cbegin(), vars.cend(), [e](const var &v) { return v.name == e; });
if (it != vars.cend()) {
sob.push(it->value);
} else {
int before = sob.size();
switch (e) {
case '&':
sob.push(pop(sob) & pop(sob));
break;
case '|':
sob.push(pop(sob) | pop(sob));
break;
case '!':
sob.push(!pop(sob));
break;
case '^':
sob.push(pop(sob) ^ pop(sob));
break;
default:
throw std::exception("Non-conformant character in expression.");
}
}
}
}
if (sob.size() != 1) {
throw std::exception("Stack should contain exactly one element.");
}
return sob.top();
}
void set_vars(int pos, const std::string &expr) {
if (pos > vars.size()) {
throw std::exception("Argument to set_vars can't be greater than the number of variables.");
}
if (pos == vars.size()) {
for (auto &v : vars) {
std::cout << (v.value ? "T " : "F ");
}
std::cout << (eval_expr(expr) ? 'T' : 'F') << '\n'; //todo implement evaluation
} else {
vars[pos].value = false;
set_vars(pos + 1, expr);
vars[pos].value = true;
set_vars(pos + 1, expr);
}
}
/* removes whitespace and converts to upper case */
std::string process_expr(const std::string &src) {
std::stringstream expr;
for (auto c : src) {
if (!isspace(c)) {
expr << (char)toupper(c);
}
}
return expr.str();
}
int main() {
std::cout << "Accepts single-character variables (except for 'T' and 'F',\n";
std::cout << "which specify explicit true or false values), postfix, with\n";
std::cout << "&|!^ for and, or, not, xor, respectively; optionally\n";
std::cout << "seperated by whitespace. Just enter nothing to quit.\n";
while (true) {
std::cout << "\nBoolean expression: ";
std::string input;
std::getline(std::cin, input);
auto expr = process_expr(input);
if (expr.length() == 0) {
break;
}
vars.clear();
for (auto e : expr) {
if (!is_operator(e) && e != 'T' && e != 'F') {
vars.push_back({ e, false });
}
}
std::cout << '\n';
if (vars.size() == 0) {
std::cout << "No variables were entered.\n";
} else {
for (auto &v : vars) {
std::cout << v.name << " ";
}
std::cout << expr << '\n';
auto h = vars.size() * 3 + expr.length();
for (size_t i = 0; i < h; i++) {
std::cout << '=';
}
std::cout << '\n';
set_vars(0, expr);
}
}
return 0;
}

247
Task/Truth-table/C-sharp/truth-table.cs Normal file
View file

@ -0,0 +1,247 @@
using System;
using System.Collections;
using System.Collections.Generic;
using System.Linq;
using System.Text;
public class TruthTable
{
enum TokenType { Unknown, WhiteSpace, Constant, Operand, Operator, LeftParenthesis, RightParenthesis }
readonly char trueConstant, falseConstant;
readonly IDictionary<char, Operator> operators = new Dictionary<char, Operator>();
public TruthTable(char falseConstant, char trueConstant)
{
this.trueConstant = trueConstant;
this.falseConstant = falseConstant;
Operators = new OperatorCollection(operators);
}
public OperatorCollection Operators { get; }
public void PrintTruthTable(string expression, bool isPostfix = false)
{
try {
foreach (string line in GetTruthTable(expression, isPostfix)) {
Console.WriteLine(line);
}
} catch (ArgumentException ex) {
Console.WriteLine(expression + " " + ex.Message);
}
}
public IEnumerable<string> GetTruthTable(string expression, bool isPostfix = false)
{
if (string.IsNullOrWhiteSpace(expression)) throw new ArgumentException("Invalid expression.");
//Maps parameters to an index in BitSet
//Makes sure they appear in the truth table in the order they first appear in the expression
var parameters = expression
.Where(c => TypeOf(c) == TokenType.Operand)
.Distinct()
.Reverse()
.Select((c, i) => (symbol: c, index: i))
.ToDictionary(p => p.symbol, p => p.index);
int count = parameters.Count;
if (count > 32) throw new ArgumentException("Cannot have more than 32 parameters.");
string header = count == 0 ? expression : string.Join(" ",
parameters.OrderByDescending(p => p.Value).Select(p => p.Key)) + " " + expression;
if (!isPostfix) expression = ConvertToPostfix(expression);
var values = default(BitSet);
var stack = new Stack<char>(expression.Length);
for (int loop = 1 << count; loop > 0; loop--) {
foreach (char token in expression) stack.Push(token);
bool result = Evaluate(stack, values, parameters);
if (header != null) {
if (stack.Count > 0) throw new ArgumentException("Invalid expression.");
yield return header;
header = null;
}
string line = (count == 0 ? "" : " ") + (result ? trueConstant : falseConstant);
line = string.Join(" ", Enumerable.Range(0, count)
.Select(i => values[count - i - 1] ? trueConstant : falseConstant)) + line;
yield return line;
values++;
}
}
public string ConvertToPostfix(string infix)
{
var stack = new Stack<char>();
var postfix = new StringBuilder();
foreach (char c in infix) {
switch (TypeOf(c)) {
case TokenType.WhiteSpace:
continue;
case TokenType.Constant:
case TokenType.Operand:
postfix.Append(c);
break;
case TokenType.Operator:
int precedence = Precedence(c);
while (stack.Count > 0 && Precedence(stack.Peek()) > precedence) {
postfix.Append(stack.Pop());
}
stack.Push(c);
break;
case TokenType.LeftParenthesis:
stack.Push(c);
break;
case TokenType.RightParenthesis:
char top = default(char);
while (stack.Count > 0) {
top = stack.Pop();
if (top == '(') break;
else postfix.Append(top);
}
if (top != '(') throw new ArgumentException("No matching left parenthesis.");
break;
default:
throw new ArgumentException("Invalid character: " + c);
}
}
while (stack.Count > 0) {
char top = stack.Pop();
if (top == '(') throw new ArgumentException("No matching right parenthesis.");
postfix.Append(top);
}
return postfix.ToString();
}
private bool Evaluate(Stack<char> expression, BitSet values, IDictionary<char, int> parameters)
{
if (expression.Count == 0) throw new ArgumentException("Invalid expression.");
char c = expression.Pop();
TokenType type = TypeOf(c);
while (type == TokenType.WhiteSpace) type = TypeOf(c = expression.Pop());
switch (type) {
case TokenType.Constant:
return c == trueConstant;
case TokenType.Operand:
return values[parameters[c]];
case TokenType.Operator:
bool right = Evaluate(expression, values, parameters);
Operator op = operators[c];
if (op.Arity == 1) return op.Function(right, right);
bool left = Evaluate(expression, values, parameters);
return op.Function(left, right);
default:
throw new ArgumentException("Invalid character: " + c);
}
}
private TokenType TypeOf(char c)
{
if (char.IsWhiteSpace(c)) return TokenType.WhiteSpace;
if (c == '(') return TokenType.LeftParenthesis;
if (c == ')') return TokenType.RightParenthesis;
if (c == trueConstant || c == falseConstant) return TokenType.Constant;
if (operators.ContainsKey(c)) return TokenType.Operator;
if (char.IsLetter(c)) return TokenType.Operand;
return TokenType.Unknown;
}
private int Precedence(char op) => operators.TryGetValue(op, out var o) ? o.Precedence : int.MinValue;
}
struct Operator
{
public Operator(char symbol, int precedence, Func<bool, bool> function) : this(symbol, precedence, 1, (l, r) => function(r)) { }
public Operator(char symbol, int precedence, Func<bool, bool, bool> function) : this(symbol, precedence, 2, function) { }
private Operator(char symbol, int precedence, int arity, Func<bool, bool, bool> function) : this()
{
Symbol = symbol;
Precedence = precedence;
Arity = arity;
Function = function;
}
public char Symbol { get; }
public int Precedence { get; }
public int Arity { get; }
public Func<bool, bool, bool> Function { get; }
}
public class OperatorCollection : IEnumerable
{
readonly IDictionary<char, Operator> operators;
internal OperatorCollection(IDictionary<char, Operator> operators) {
this.operators = operators;
}
public void Add(char symbol, int precedence, Func<bool, bool> function)
=> operators[symbol] = new Operator(symbol, precedence, function);
public void Add(char symbol, int precedence, Func<bool, bool, bool> function)
=> operators[symbol] = new Operator(symbol, precedence, function);
public void Remove(char symbol) => operators.Remove(symbol);
IEnumerator IEnumerable.GetEnumerator() => operators.Values.GetEnumerator();
}
struct BitSet
{
private int bits;
private BitSet(int bits) { this.bits = bits; }
public static BitSet operator ++(BitSet bitSet) => new BitSet(bitSet.bits + 1);
public bool this[int index] => (bits & (1 << index)) != 0;
}
class Program
{
public static void Main() {
TruthTable tt = new TruthTable('F', 'T') {
Operators = {
{ '!', 6, r => !r },
{ '&', 5, (l, r) => l && r },
{ '^', 4, (l, r) => l ^ r },
{ '|', 3, (l, r) => l || r }
}
};
//Add a crazy operator:
var rng = new Random();
tt.Operators.Add('?', 6, r => rng.NextDouble() < 0.5);
string[] expressions = {
"!!!T",
"?T",
"F & x | T",
"F & (x | T",
"F & x | T)",
"a ! (a & a)",
"a | (a * a)",
"a ^ T & (b & !c)",
};
foreach (string expression in expressions) {
tt.PrintTruthTable(expression);
Console.WriteLine();
}
//Define a different language
tt = new TruthTable('0', '1') {
Operators = {
{ '-', 6, r => !r },
{ '^', 5, (l, r) => l && r },
{ 'v', 3, (l, r) => l || r },
{ '>', 2, (l, r) => !l || r },
{ '=', 1, (l, r) => l == r },
}
};
expressions = new[] {
"-X v 0 = X ^ 1",
"(H > M) ^ (S > H) > (S > M)"
};
foreach (string expression in expressions) {
tt.PrintTruthTable(expression);
Console.WriteLine();
}
}
}

193
Task/Truth-table/C/truth-table.c Normal file
View file

@ -0,0 +1,193 @@
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#define TRUE 1
#define FALSE 0
#define STACK_SIZE 80
#define BUFFER_SIZE 100
typedef int bool;
typedef struct {
char name;
bool val;
} var;
typedef struct {
int top;
bool els[STACK_SIZE];
} stack_of_bool;
char expr[BUFFER_SIZE];
int expr_len;
var vars[24];
int vars_len;
/* stack manipulation functions */
bool is_full(stack_of_bool *sp) {
return sp->top == STACK_SIZE - 1;
}
bool is_empty(stack_of_bool *sp) {
return sp->top == -1;
}
bool peek(stack_of_bool *sp) {
if (!is_empty(sp))
return sp->els[sp->top];
else {
printf("Stack is empty.\n");
exit(1);
}
}
void push(stack_of_bool *sp, bool val) {
if (!is_full(sp)) {
sp->els[++(sp->top)] = val;
}
else {
printf("Stack is full.\n");
exit(1);
}
}
bool pop(stack_of_bool *sp) {
if (!is_empty(sp))
return sp->els[(sp->top)--];
else {
printf("\nStack is empty.\n");
exit(1);
}
}
void make_empty(stack_of_bool *sp) {
sp->top = -1;
}
int elems_count(stack_of_bool *sp) {
return (sp->top) + 1;
}
bool is_operator(const char c) {
return c == '&' || c == '|' || c == '!' || c == '^';
}
int vars_index(const char c) {
int i;
for (i = 0; i < vars_len; ++i) {
if (vars[i].name == c) return i;
}
return -1;
}
bool eval_expr() {
int i, vi;
char e;
stack_of_bool s;
stack_of_bool *sp = &s;
make_empty(sp);
for (i = 0; i < expr_len; ++i) {
e = expr[i];
if (e == 'T')
push(sp, TRUE);
else if (e == 'F')
push(sp, FALSE);
else if((vi = vars_index(e)) >= 0) {
push(sp, vars[vi].val);
}
else switch(e) {
case '&':
push(sp, pop(sp) & pop(sp));
break;
case '|':
push(sp, pop(sp) | pop(sp));
break;
case '!':
push(sp, !pop(sp));
break;
case '^':
push(sp, pop(sp) ^ pop(sp));
break;
default:
printf("\nNon-conformant character '%c' in expression.\n", e);
exit(1);
}
}
if (elems_count(sp) != 1) {
printf("\nStack should contain exactly one element.\n");
exit(1);
}
return peek(sp);
}
void set_vars(int pos) {
int i;
if (pos > vars_len) {
printf("\nArgument to set_vars can't be greater than the number of variables.\n");
exit(1);
}
else if (pos == vars_len) {
for (i = 0; i < vars_len; ++i) {
printf((vars[i].val) ? "T " : "F ");
}
printf("%c\n", (eval_expr()) ? 'T' : 'F');
}
else {
vars[pos].val = FALSE;
set_vars(pos + 1);
vars[pos].val = TRUE;
set_vars(pos + 1);
}
}
/* removes whitespace and converts to upper case */
void process_expr() {
int i, count = 0;
for (i = 0; expr[i]; ++i) {
if (!isspace(expr[i])) expr[count++] = toupper(expr[i]);
}
expr[count] = '\0';
}
int main() {
int i, h;
char e;
printf("Accepts single-character variables (except for 'T' and 'F',\n");
printf("which specify explicit true or false values), postfix, with\n");
printf("&|!^ for and, or, not, xor, respectively; optionally\n");
printf("seperated by whitespace. Just enter nothing to quit.\n");
while (TRUE) {
printf("\nBoolean expression: ");
fgets(expr, BUFFER_SIZE, stdin);
fflush(stdin);
process_expr();
expr_len = strlen(expr);
if (expr_len == 0) break;
vars_len = 0;
for (i = 0; i < expr_len; ++i) {
e = expr[i];
if (!is_operator(e) && e != 'T' && e != 'F' && vars_index(e) == -1) {
vars[vars_len].name = e;
vars[vars_len].val = FALSE;
vars_len++;
}
}
printf("\n");
if (vars_len == 0) {
printf("No variables were entered.\n");
}
else {
for (i = 0; i < vars_len; ++i)
printf("%c ", vars[i].name);
printf("%s\n", expr);
h = vars_len * 3 + expr_len;
for (i = 0; i < h; ++i) printf("=");
printf("\n");
set_vars(0);
}
}
return 0;
}

99
Task/Truth-table/Clojure/truth-table.clj Normal file
View file

@ -0,0 +1,99 @@
(ns clojure-sandbox.truthtables
(:require [clojure.string :as s]
[clojure.pprint :as pprint]))
;; Definitions of the logical operators
(defn !op [expr]
(not expr))
(defn |op [e1 e2]
(not (and (not e1)
(not e2))))
(defn &op [e1 e2]
(and e1 e2))
(defn ->op [e1 e2]
(if e1
e2
true))
(def operators {"!" !op
"|" |op
"&" &op
"->" ->op})
;; The evaluations of expressions always call the value method on sub-expressions
(defn evaluate-unary [operator operand valuemap]
(let [operand-value (value operand valuemap)
operator (get operators operator)]
(operator operand-value)))
(defn evaluate-binary [o1 op o2 valuemap]
(let [op1-value (value o1 valuemap)
op2-value (value o2 valuemap)
operator (get operators op)]
(operator op1-value op2-value)))
;; Protocol to handle all kinds of expressions : unary (!x), binary (x & y), symbolic (x)
(defprotocol Expression
(value [_ valuemap] "Returns boolean value of expression")) ;; this value map specifies the variables' truth values
(defrecord UnaryExpression [operator operand]
Expression
(value [self valuemap] (evaluate-unary operator operand valuemap)))
(defrecord BinaryExpression [op1 operator op2]
Expression
(value [self valuemap] (evaluate-binary op1 operator op2 valuemap)))
(defrecord SymbolExpression [operand]
Expression
(value [self valuemap] (get valuemap operand)))
;; Recursively create the right kind of boolean expression, evaluating from the right
(defn expression [inputs]
(if (contains? operators (first inputs))
(->UnaryExpression (first inputs) (expression (rest inputs)))
(if (= 1 (count inputs))
(->SymbolExpression (first inputs))
(->BinaryExpression (->SymbolExpression (first inputs)) (nth inputs 1) (expression (nthrest inputs (- (count inputs) 1)))))))
;; This won't handle brackets, so it is all evaluated right to left
(defn parse [input-str]
(-> input-str
s/trim ;; remove leading/trailing space
(s/split #"\s+"))) ;;remove intermediate spaces
(defn extract-var-names [inputs]
"Get a list of variables that can have truth value"
(->> inputs
(filter (fn[i] (not (contains? operators i))))
set))
(defn all-var-values [inputs]
"Returns a list of all potential variable assignments"
(let [vars (extract-var-names inputs)]
(loop [vars-left vars
outputs []]
(if (empty? vars-left)
outputs
(let [this-var (first vars-left)]
(if (empty? outputs)
(recur (rest vars-left) [{this-var true} {this-var false}])
(recur (rest vars-left)
(concat (map (fn[x] (assoc x this-var true)) outputs)
(map (fn[x] (assoc x this-var false)) outputs)))))))))
(defn truth-table [input]
"Print out the truth table for an input string"
(let [input-values (parse input)
value-maps (all-var-values input-values)
expression (expression input-values)]
(value expression (first value-maps))
(->> value-maps
(map (fn [x] (assoc x input (value expression x))))
pprint/print-table)))
(truth-table "! a | b") ;; interpreted as ! (a | b)

341
Task/Truth-table/Cowgol/truth-table.cowgol Normal file
View file

@ -0,0 +1,341 @@
# Truth table generator in Cowgol
# -
# This program will generate a truth table for the Boolean expression
# given on the command line.
#
# The expression is in infix notation, and operator precedence is impemented,
# i.e., the following expression:
# A & B | C & D => E
# is parsed as:
# ((A & B) | (C & D)) => E.
#
# Syntax:
# * Variables are single letters (A-Z). They are case-insensitive.
# * 0 and 1 can be used as constant true or false.
# * Operators are ~ (not), & (and), | (or), ^ (xor), and => (implies).
# * Parentheses may be used to override the normal precedence.
include "cowgol.coh";
include "strings.coh";
include "argv.coh";
ArgvInit();
# Concatenate all command line arguments together, skipping whitespace
var code: uint8[512];
var codeptr := &code[0];
loop
var argmt := ArgvNext();
if argmt == 0 as [uint8] then break; end if;
loop
var char := [argmt];
argmt := @next argmt;
if char == 0 then break;
elseif char == ' ' then continue;
end if;
[codeptr] := char;
codeptr := @next codeptr;
end loop;
end loop;
[codeptr] := 0;
# If no code given, print an error and stop
if StrLen(&code[0]) == 0 then
print("Error: no boolean expression given\n");
ExitWithError();
end if;
interface TokenReader(str: [uint8]): (next: [uint8], tok: uint8);
# Operators
interface OpFn(l: uint8, r: uint8): (v: uint8);
sub And implements OpFn is v := l & r; end sub;
sub Or implements OpFn is v := l | r; end sub;
sub Xor implements OpFn is v := l ^ r; end sub;
sub Not implements OpFn is v := ~l; end sub;
sub Impl implements OpFn is
if l == 0 then v := 1;
else v := r;
end if;
end sub;
record Operator is
fn: OpFn;
name: [uint8];
val: uint8;
prec: uint8;
end record;
var ops: Operator[] := {
{Not, "~", 1, 5},
{And, "&", 2, 4},
{Or, "|", 2, 3},
{Xor, "^", 2, 3},
{Impl, "=>", 2, 2}
};
const TOKEN_MASK := (1<<5)-1;
const TOKEN_OP := 1<<5;
sub ReadOp implements TokenReader is
tok := 0;
next := str;
while tok < @sizeof ops loop
var find := ops[tok].name;
while [find] == [next] loop
next := @next next;
find := @next find;
end loop;
if [find] == 0 then
tok := tok | TOKEN_OP;
return;
end if;
next := str;
tok := tok + 1;
end loop;
tok := 0;
end sub;
# Values (constants, variables)
const TOKEN_VAR := 2<<5;
const TOKEN_CONST := 3<<5;
const CONST_TRUE := 0;
const CONST_FALSE := 1;
sub ReadValue implements TokenReader is
var cur := [str];
next := str;
tok := 0;
if cur == '0' or cur == '1' then
next := @next str;
tok := TOKEN_CONST | cur - '0';
elseif (cur >= 'A' and cur <= 'Z') or (cur >= 'a' and cur <= 'z') then
next := @next str;
tok := TOKEN_VAR | (cur | 32) - 'a';
end if;
end sub;
# Parentheses
const TOKEN_PAR := 4<<5;
const PAR_OPEN := 0;
const PAR_CLOSE := 1;
sub ReadParen implements TokenReader is
case [str] is
when '(': next := @next str; tok := TOKEN_PAR | PAR_OPEN;
when ')': next := @next str; tok := TOKEN_PAR | PAR_CLOSE;
when else: next := str; tok := 0;
end case;
end sub;
# Read next token
sub NextToken(str: [uint8]): (next: [uint8], tok: uint8) is
var toks: TokenReader[] := {ReadOp, ReadValue, ReadParen};
var i: uint8 := 0;
while i < @sizeof toks loop
(next, tok) := (toks[i]) (str);
if tok != 0 then return; end if;
i := i + 1;
end loop;
# Invalid token
print("cannot tokenize: ");
print(str);
print_nl();
ExitWithError();
end sub;
# Use shunting yard algorithm to parse the input
var expression: uint8[512];
var oprstack: uint8[512];
var expr_ptr := &expression[0];
var ostop := &oprstack[0];
var varmask: uint32 := 0; # mark which variables are in use
var one: uint32 := 1; # cannot shift constant by variable
sub GetOp(o: uint8): (r: [Operator]) is
r := &ops[o];
end sub;
codeptr := &code[0];
while [codeptr] != 0 loop
var tok: uint8;
(codeptr, tok) := NextToken(codeptr);
var toktype := tok & ~TOKEN_MASK;
var tokval := tok & TOKEN_MASK;
case toktype is
# constants and variables get pushed to output queue
when TOKEN_CONST:
[expr_ptr] := tok; expr_ptr := @next expr_ptr;
when TOKEN_VAR:
[expr_ptr] := tok; expr_ptr := @next expr_ptr;
varmask := varmask | one << tokval;
# operators
when TOKEN_OP:
if ops[tokval].val == 1 then
# unary operator binds immediately
[ostop] := tok; ostop := @next ostop;
else
while ostop > &oprstack[0]
and [@prev ostop] != TOKEN_PAR|PAR_OPEN
and [GetOp([@prev ostop] & TOKEN_MASK)].prec
>= ops[tokval].prec
loop
ostop := @prev ostop;
[expr_ptr] := [ostop];
expr_ptr := @next expr_ptr;
end loop;
[ostop] := tok;
ostop := @next ostop;
end if;
# parenthesis
when TOKEN_PAR:
if tokval == PAR_OPEN then
# push left parenthesis onto operator stack
[ostop] := tok; ostop := @next ostop;
else
# pop whole operator stack until left parenthesis
while ostop > &oprstack[0]
and [@prev ostop] != TOKEN_PAR|PAR_OPEN
loop
ostop := @prev ostop;
[expr_ptr] := [ostop];
expr_ptr := @next expr_ptr;
end loop;
# if we run out of stack, mismatched parenthesis
if ostop == &oprstack[0] then
print("Error: missing (");
print_nl();
ExitWithError();
else
ostop := @prev ostop;
end if;
end if;
end case;
end loop;
# push remaining operators onto expression
while ostop != &oprstack[0] loop
ostop := @prev ostop;
[expr_ptr] := [ostop];
if [expr_ptr] & ~TOKEN_MASK == TOKEN_PAR then
print("Error: missing )");
print_nl();
ExitWithError();
end if;
expr_ptr := @next expr_ptr;
end loop;
# terminate expression
[expr_ptr] := 0;
# Evaluate expression given set of variables
sub Eval(varset: uint32): (r: uint8) is
# We can reuse the operator stack as the evaluation stack
var ptr := &oprstack[0];
var exp := &expression[0];
var one: uint32 := 1;
while [exp] != 0 loop
var toktype := [exp] & ~TOKEN_MASK;
var tokval := [exp] & TOKEN_MASK;
case toktype is
when TOKEN_CONST:
[ptr] := tokval;
ptr := @next ptr;
when TOKEN_VAR:
[ptr] := ((varset & (one << tokval)) >> tokval) as uint8;
ptr := @next ptr;
when TOKEN_OP:
var op := GetOp(tokval);
ptr := ptr - ([op].val as intptr);
if ptr < &oprstack[0] then
# not enough values on the stack
print("Missing operand\n");
ExitWithError();
end if;
[ptr] := ([op].fn)([ptr], [@next ptr]) & 1;
ptr := @next ptr;
when else:
# wrong token left in the expression
print("invalid expression token ");
print_hex_i8([exp]);
print_nl();
ExitWithError();
end case;
exp := @next exp;
end loop;
# There should be exactly one item on the stack
ptr := @prev ptr;
if ptr != &oprstack[0] then
print("Too many operands\n");
ExitWithError();
else
r := [ptr];
end if;
end sub;
var v := Eval(0); # evaluate once to catch errors
# Print header and count variables
var ch: uint8 := 'A';
var vcount: uint8 := 0;
var vars := varmask;
while vars != 0 loop
if vars & 1 != 0 then
print_char(ch);
print_char(' ');
vcount := vcount + 1;
end if;
ch := ch + 1;
vars := vars >> 1;
end loop;
print("| ");
print(&code[0]);
print_nl();
ch := 2 + vcount * 2 + StrLen(&code[0]) as uint8;
while ch != 0 loop
print_char('-');
ch := ch - 1;
end loop;
print_nl();
# Given configuration number, generate variable configuration
sub distr(val: uint32): (r: uint32) is
var vars := varmask;
r := 0;
var n: uint8 := 0;
while vars != 0 loop
r := r >> 1;
if vars & 1 != 0 then
r := r | ((val & 1) << 31);
val := val >> 1;
end if;
vars := vars >> 1;
n := n + 1;
end loop;
r := r >> (32-n);
end sub;
vars := 0; # start with F F F F F
var bools: uint8[] := {'F', 'T'};
while vars != one << vcount loop
var dist := distr(vars);
var rslt := Eval(dist);
# print configuration
var vmask := varmask;
while vmask != 0 loop
if vmask & 1 != 0 then
print_char(bools[(dist & 1) as uint8]);
print_char(' ');
end if;
vmask := vmask >> 1;
dist := dist >> 1;
end loop;
# print result
print("| ");
print_char(bools[rslt]);
print_nl();
# next configuration
vars := vars + 1;
end loop;

89
Task/Truth-table/D/truth-table.d Normal file
View file

@ -0,0 +1,89 @@
import std.stdio, std.string, std.array, std.algorithm, std.typecons;
struct Var {
const char name;
bool val;
}
const string expr;
Var[] vars;
bool pop(ref bool[] arr) pure nothrow {
const last = arr.back;
arr.popBack;
return last;
}
enum isOperator = (in char c) pure => "&|!^".canFind(c);
enum varsCountUntil = (in char c) nothrow =>
.vars.map!(v => v.name).countUntil(c).Nullable!(int, -1);
bool evalExp() {
bool[] stack;
foreach (immutable e; .expr) {
if (e == 'T')
stack ~= true;
else if (e == 'F')
stack ~= false;
else if (!e.varsCountUntil.isNull)
stack ~= .vars[e.varsCountUntil.get].val;
else switch (e) {
case '&':
stack ~= stack.pop & stack.pop;
break;
case '|':
stack ~= stack.pop | stack.pop;
break;
case '!':
stack ~= !stack.pop;
break;
case '^':
stack ~= stack.pop ^ stack.pop;
break;
default:
throw new Exception("Non-conformant character '" ~
e ~ "' in expression.");
}
}
assert(stack.length == 1);
return stack.back;
}
void setVariables(in size_t pos)
in {
assert(pos <= .vars.length);
} body {
if (pos == .vars.length)
return writefln("%-(%s %) %s",
.vars.map!(v => v.val ? "T" : "F"),
evalExp ? "T" : "F");
.vars[pos].val = false;
setVariables(pos + 1);
.vars[pos].val = true;
setVariables(pos + 1);
}
static this() {
"Accepts single-character variables (except for 'T' and 'F',
which specify explicit true or false values), postfix, with
&|!^ for and, or, not, xor, respectively; optionally
seperated by whitespace.".writeln;
"Boolean expression: ".write;
.expr = readln.split.join;
}
void main() {
foreach (immutable e; expr)
if (!e.isOperator && !"TF".canFind(e) &&
e.varsCountUntil.isNull)
.vars ~= Var(e);
if (.vars.empty)
return;
writefln("%-(%s %) %s", .vars.map!(v => v.name), .expr);
setVariables(0);
}

58
Task/Truth-table/Factor/truth-table.factor Normal file
View file

@ -0,0 +1,58 @@
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

142
Task/Truth-table/Go/truth-table.go Normal file
View file

@ -0,0 +1,142 @@
package main
import (
"bufio"
"errors"
"fmt"
"go/ast"
"go/parser"
"go/token"
"os"
"reflect"
)
func main() {
in := bufio.NewScanner(os.Stdin)
for {
fmt.Print("Expr: ")
in.Scan()
if err := in.Err(); err != nil {
fmt.Println(err)
return
}
if !tt(in.Text()) {
return
}
}
}
func tt(expr string) bool {
// call library parser
tree, err := parser.ParseExpr(expr)
if err != nil {
fmt.Println(err)
return false
}
// create handy object to pass around
e := &evaluator{nil, map[string]bool{}, tree}
// library tree traversal function calls e.Visit for each node.
// use this to collect variables of the expression.
ast.Walk(e, tree)
// print headings for truth table
for _, n := range e.names {
fmt.Printf("%-6s", n)
}
fmt.Println(" ", expr)
// start recursive table generation function on first variable
e.evalVar(0)
return true
}
type evaluator struct {
names []string // variables, in order of appearance
val map[string]bool // map variables to boolean values
tree ast.Expr // parsed expression as ast
}
// visitor function called by library Walk function.
// builds a list of unique variable names.
func (e *evaluator) Visit(n ast.Node) ast.Visitor {
if id, ok := n.(*ast.Ident); ok {
if !e.val[id.Name] {
e.names = append(e.names, id.Name)
e.val[id.Name] = true
}
}
return e
}
// method recurses for each variable of the truth table, assigning it to
// false, then true. At bottom of recursion, when all variables are
// assigned, it evaluates the expression and outputs one line of the
// truth table
func (e *evaluator) evalVar(nx int) bool {
if nx == len(e.names) {
// base case
v, err := evalNode(e.tree, e.val)
if err != nil {
fmt.Println(" ", err)
return false
}
// print variable values
for _, n := range e.names {
fmt.Printf("%-6t", e.val[n])
}
// print expression value
fmt.Println(" ", v)
return true
}
// recursive case
for _, v := range []bool{false, true} {
e.val[e.names[nx]] = v
if !e.evalVar(nx + 1) {
return false
}
}
return true
}
// recursively evaluate ast
func evalNode(nd ast.Node, val map[string]bool) (bool, error) {
switch n := nd.(type) {
case *ast.Ident:
return val[n.Name], nil
case *ast.BinaryExpr:
x, err := evalNode(n.X, val)
if err != nil {
return false, err
}
y, err := evalNode(n.Y, val)
if err != nil {
return false, err
}
switch n.Op {
case token.AND:
return x && y, nil
case token.OR:
return x || y, nil
case token.XOR:
return x != y, nil
default:
return unsup(n.Op)
}
case *ast.UnaryExpr:
x, err := evalNode(n.X, val)
if err != nil {
return false, err
}
switch n.Op {
case token.XOR:
return !x, nil
default:
return unsup(n.Op)
}
case *ast.ParenExpr:
return evalNode(n.X, val)
}
return unsup(reflect.TypeOf(nd))
}
func unsup(i interface{}) (bool, error) {
return false, errors.New(fmt.Sprintf("%v unsupported", i))
}

34
Task/Truth-table/Haskell/truth-table-1.hs Normal file
View file

@ -0,0 +1,34 @@
import Control.Monad (mapM, foldM, forever)
import Data.List (unwords, unlines, nub)
import Data.Maybe (fromJust)
truthTable expr = let
tokens = words expr
operators = ["&", "|", "!", "^", "=>"]
variables = nub $ filter (not . (`elem` operators)) tokens
table = zip variables <$> mapM (const [True,False]) variables
results = map (\r -> (map snd r) ++ (calculate tokens) r) table
header = variables ++ ["result"]
in
showTable $ header : map (map show) results
-- Performs evaluation of token sequence in a given context.
-- The context is an assoc-list, which binds variable and it's value.
-- Here the monad is simple ((->) r).
calculate :: [String] -> [(String, Bool)] -> [Bool]
calculate = foldM interprete []
where
interprete (x:y:s) "&" = (: s) <$> pure (x && y)
interprete (x:y:s) "|" = (: s) <$> pure (x || y)
interprete (x:y:s) "^" = (: s) <$> pure (x /= y)
interprete (x:y:s) "=>" = (: s) <$> pure (not y || x)
interprete (x:s) "!" = (: s) <$> pure (not x)
interprete s var = (: s) <$> fromJust . lookup var
-- pretty printing
showTable tbl = unlines $ map (unwords . map align) tbl
where
align txt = take colWidth $ txt ++ repeat ' '
colWidth = max 6 $ maximum $ map length (head tbl)
main = forever $ getLine >>= putStrLn . truthTable

13
Task/Truth-table/Haskell/truth-table-2.hs Normal file
View file

@ -0,0 +1,13 @@
{-# LANGUAGE FlexibleContexts #-}
import Text.Parsec
toRPN = parse impl "expression" . filter (/= ' ')
where
impl = chainl1 disj (op2 "=>")
disj = chainl1 conj (op2 "|" <|> op2 "^")
conj = chainl1 term (op2 "&")
term = string "(" *> impl <* string ")" <|>
op1 "!" <*> term <|>
many1 alphaNum
op1 s = (\x -> unwords [x, s]) <$ string s
op2 s = (\x y -> unwords [x, y, s]) <$ string s

11
Task/Truth-table/Haskell/truth-table-3.hs Normal file
View file

@ -0,0 +1,11 @@
λ> putStr $ truthTable $ toRPN "(Human => Mortal) & (Socratus => Human) => (Socratus => Mortal)"
Human Mortal Socratus result
True True True True
True True False True
True False True True
True False False True
False True True True
False True False True
False False True True
False False False True

7
Task/Truth-table/J/truth-table-1.j Normal file
View file

@ -0,0 +1,7 @@
truthTable=:3 :0
assert. -. 1 e. 'data expr names table' e.&;: y
names=. ~. (#~ _1 <: nc) ;:expr=. y
data=. #:i.2^#names
(names)=. |:data
(' ',;:inv names,<expr),(1+#@>names,<expr)":data,.".expr
)

32
Task/Truth-table/J/truth-table-2.j Normal file
View file

@ -0,0 +1,32 @@
truthTable '-.b'
b -.b
0 1
1 0
truthTable 'a*b'
a b a*b
0 0 0
0 1 0
1 0 0
1 1 1
truthTable 'a+.b'
a b a+.b
0 0 0
0 1 1
1 0 1
1 1 1
truthTable 'a<:b'
a b a<:b
0 0 1
0 1 1
1 0 0
1 1 1
truthTable '(a*bc)+.d'
a bc d (a*bc)+.d
0 0 0 0
0 0 1 1
0 1 0 0
0 1 1 1
1 0 0 0
1 0 1 1
1 1 0 1
1 1 1 1

118
Task/Truth-table/Java/truth-table.java Normal file
View file

@ -0,0 +1,118 @@
import java.util.ArrayList;
import java.util.HashMap;
import java.util.Iterator;
import java.util.LinkedHashSet;
import java.util.List;
import java.util.Map;
import java.util.Set;
import java.util.Stack;
public class TruthTable {
public static void main( final String... args ) {
System.out.println( new TruthTable( args ) );
}
private interface Operator {
boolean evaluate( Stack<Boolean> s );
}
/**
* Supported operators and what they do. For more ops, add entries here.
*/
private static final Map<String,Operator> operators = new HashMap<String,Operator>() {{
// Can't use && or || because shortcut evaluation may mean the stack is not popped enough
put( "&", stack -> Boolean.logicalAnd( stack.pop(), stack.pop() ) );
put( "|", stack -> Boolean.logicalOr( stack.pop(), stack.pop() ) );
put( "!", stack -> ! stack.pop() );
put( "^", stack -> ! stack.pop().equals ( stack.pop() ) );
}};
private final List<String> variables;
private final String[] symbols;
/**
* Constructs a truth table for the symbols in an expression.
*/
public TruthTable( final String... symbols ) {
final Set<String> variables = new LinkedHashSet<>();
for ( final String symbol : symbols ) {
if ( ! operators.containsKey( symbol ) ) {
variables.add( symbol );
}
}
this.variables = new ArrayList<>( variables );
this.symbols = symbols;
}
@Override
public String toString () {
final StringBuilder result = new StringBuilder();
for ( final String variable : variables ) {
result.append( variable ).append( ' ' );
}
result.append( ' ' );
for ( final String symbol : symbols ) {
result.append( symbol ).append ( ' ' );
}
result.append( '\n' );
for ( final List<Boolean> values : enumerate( variables.size () ) ) {
final Iterator<String> i = variables.iterator();
for ( final Boolean value : values ) {
result.append(
String.format(
"%-" + i.next().length() + "c ",
value ? 'T' : 'F'
)
);
}
result.append( ' ' )
.append( evaluate( values ) ? 'T' : 'F' )
.append( '\n' );
}
return result.toString ();
}
/**
* Recursively generates T/F values
*/
private static List<List<Boolean>> enumerate( final int size ) {
if ( 1 == size )
return new ArrayList<List<Boolean>>() {{
add( new ArrayList<Boolean>() {{ add(false); }} );
add( new ArrayList<Boolean>() {{ add(true); }} );
}};
return new ArrayList<List<Boolean>>() {{
for ( final List<Boolean> head : enumerate( size - 1 ) ) {
add( new ArrayList<Boolean>( head ) {{ add(false); }} );
add( new ArrayList<Boolean>( head ) {{ add(true); }} );
}
}};
}
/**
* Evaluates the expression for a set of values.
*/
private boolean evaluate( final List<Boolean> enumeration ) {
final Iterator<Boolean> i = enumeration.iterator();
final Map<String,Boolean> values = new HashMap<>();
final Stack<Boolean> stack = new Stack<>();
variables.forEach ( v -> values.put( v, i.next() ) );
for ( final String symbol : symbols ) {
final Operator op = operators.get ( symbol );
// Reverse Polish notation makes this bit easy
stack.push(
null == op
? values.get ( symbol )
: op.evaluate ( stack )
);
}
return stack.pop();
}
}

60
Task/Truth-table/JavaScript/truth-table.js Normal file
View file

@ -0,0 +1,60 @@
<!DOCTYPE html><html><head><title>Truth table</title><script>
var elem,expr,vars;
function isboolop(chr){return "&|!^".indexOf(chr)!=-1;}
function varsindexof(chr){
var i;
for(i=0;i<vars.length;i++){if(vars[i][0]==chr)return i;}
return -1;
}
function printtruthtable(){
var i,str;
elem=document.createElement("pre");
expr=prompt("Boolean expression:\nAccepts single-character variables (except for \"T\" and \"F\", which specify explicit true or false values), postfix, with \"&|!^\" for and, or, not, xor, respectively; optionally seperated by whitespace.").replace(/\s/g,"");
vars=[];
for(i=0;i<expr.length;i++)if(!isboolop(expr[i])&&expr[i]!="T"&&expr[i]!="F"&&varsindexof(expr[i])==-1)vars.push([expr[i],-1]);
if(vars.length==0)return;
str="";
for(i=0;i<vars.length;i++)str+=vars[i][0]+" ";
elem.innerHTML="<b>"+str+expr+"</b>\n";
vars[0][1]=false;
truthpartfor(1);
vars[0][1]=true;
truthpartfor(1);
vars[0][1]=-1;
document.body.appendChild(elem);
}
function truthpartfor(index){
if(index==vars.length){
var str,i;
str="";
for(i=0;i<index;i++)str+=(vars[i][1]?"<b>T</b>":"F")+" ";
elem.innerHTML+=str+(parsebool()?"<b>T</b>":"F")+"\n";
return;
}
vars[index][1]=false;
truthpartfor(index+1);
vars[index][1]=true;
truthpartfor(index+1);
vars[index][1]=-1;
}
function parsebool(){
var stack,i,idx;
console.log(vars);
stack=[];
for(i=0;i<expr.length;i++){
if(expr[i]=="T")stack.push(true);
else if(expr[i]=="F")stack.push(false);
else if((idx=varsindexof(expr[i]))!=-1)stack.push(vars[idx][1]);
else if(isboolop(expr[i])){
switch(expr[i]){
case "&":stack.push(stack.pop()&stack.pop());break;
case "|":stack.push(stack.pop()|stack.pop());break;
case "!":stack.push(!stack.pop());break;
case "^":stack.push(stack.pop()^stack.pop());break;
}
} else alert("Non-conformant character "+expr[i]+" in expression. Should not be possible.");
console.log(stack);
}
return stack[0];
}
</script></head><body onload="printtruthtable()"></body></html>

25
Task/Truth-table/Jq/truth-table-1.jq Normal file
View file

@ -0,0 +1,25 @@
include "peg"; # see [[:Category:jq/peg.jq]
def expr:
def Var : parse("[A-Z][a-zA-Z0-9]*");
def boolean : (literal("true") // literal("false"))
| .result[-1] |= fromjson;
def primary : ws
| (Var
// boolean
// box(q("(") | expr | q(")"))
)
| ws;
def e3 : ws | (box(literal("not") | primary) // primary);
def e2 : box(e3 | star(literal("and") | e3)) ;
def e1 : box(e2 | star((literal("or") // literal("xor")) | e2)) ;
def e0 : box(primary | literal("=>") | primary) // e1;
ws | e0 | ws;
def statement:
{remainder: .} | expr | eos;

15
Task/Truth-table/Jq/truth-table-2.jq Normal file
View file

@ -0,0 +1,15 @@
# Evaluate $Expr in the context of {A,B,....}
def eval($Expr):
if $Expr|type == "boolean" then $Expr
elif $Expr|type == "string" then getpath([$Expr])
elif $Expr|length == 1 then eval($Expr[0])
elif $Expr|(length == 2 and first == "not") then eval($Expr[-1])|not
elif $Expr|(length == 3 and .[1] == "or") then eval($Expr[0]) or eval($Expr[2])
elif $Expr|(length == 3 and .[1] == "xor")
then eval($Expr[0]) as $x
| eval($Expr[2]) as $y
| ($x and ($y|not)) or ($y and ($x|not))
elif $Expr|(length == 3 and .[1] == "and") then eval($Expr[0]) and eval($Expr[2])
elif $Expr|(length == 3 and .[1] == "=>") then (eval($Expr[0])|not) or eval($Expr[2])
else $Expr | error
end;

22
Task/Truth-table/Jq/truth-table-3.jq Normal file
View file

@ -0,0 +1,22 @@
# input: a list of strings
# output: a stream of objects representing all possible true/false combinations
# Each object has the keys specified in the input.
def vars2tf:
if length == 0 then {}
else .[0] as $k
| ({} | .[$k] = (true,false)) + (.[1:] | vars2tf)
end;
# If the input is a string, then echo it;
# otherwise emit T or F
def TF:
if type == "string" then .
elif . then "T"
else "F"
end;
# Extract the distinct variable names from the parse tree.
def vars: [.. | strings | select(test("^[A-Z]"))] | unique;
def underscore:
., (length * "_");

22
Task/Truth-table/Jq/truth-table-4.jq Normal file
View file

@ -0,0 +1,22 @@
def tests: [
"A xor B",
"notA",
"A and B",
"A and B or C",
"A=>(notB)",
"A=>(A => (B or A))",
"A xor B and C"
];
def tables:
tests[] as $test
| ($test | statement | .result)
| . as $result
| vars as $vars
| ($vars + [" ", $test] | join(" ") | underscore),
(($vars | vars2tf)
| ( [.[], " ", eval($result) | TF] | join(" ")) ),
""
;
tables

43
Task/Truth-table/Julia/truth-table-1.julia Normal file
View file

@ -0,0 +1,43 @@
module TruthTable
using Printf
using MacroTools
isvariablename(::Any) = false
isvariablename(s::Symbol) = all(x -> isletter(x) || x == '_', string(s))
function table(expr)
if !isvariablename(expr) && !Meta.isexpr(expr, :call)
throw(ArgumentError("expr must be a boolean expression"))
end
exprstr = string(expr)
# Collect variable names
symset = Set{Symbol}()
MacroTools.prewalk(expr) do node
isvariablename(node) && push!(symset, node)
return node
end
symlist = collect(symset)
# Create assignment assertions + evaluate
blocks = Vector{Expr}(undef, 2 ^ length(symlist) + 1)
blocks[1] = quote
println(join(lpad.($(symlist), 6), " | "), " || ", $exprstr)
end
for (i, tup) in enumerate(Iterators.product(Iterators.repeated((false, true), length(symlist))...))
blocks[i + 1] = quote
let $(Expr(:(=), Expr(:tuple, symlist...), Expr(:tuple, tup...)))
println(join(lpad.($(Expr(:tuple, symlist...)), 6), " | "), " || ", lpad($expr, $(length(exprstr))))
end
end
end
return esc(Expr(:block, blocks...))
end
macro table(expr)
return table(expr)
end
end # module TruthTable

4
Task/Truth-table/Julia/truth-table-2.julia Normal file
View file

@ -0,0 +1,4 @@
TruthTable.@table !a
TruthTable.@table a | b
TruthTable.@table (a ⊻ b) | (c & a)
TruthTable.@table (a & b) | (c ⊻ d)

74
Task/Truth-table/Kotlin/truth-table.kotlin Normal file
View file

@ -0,0 +1,74 @@
// Version 1.2.31
import java.util.Stack
class Variable(val name: Char, var value: Boolean = false)
lateinit var expr: String
var variables = mutableListOf<Variable>()
fun Char.isOperator() = this in "&|!^"
fun Char.isVariable() = this in variables.map { it.name }
fun evalExpression(): Boolean {
val stack = Stack<Boolean>()
for (e in expr) {
stack.push(
if (e == 'T')
true
else if (e == 'F')
false
else if (e.isVariable())
variables.single { it.name == e }.value
else when (e) {
'&' -> stack.pop() and stack.pop()
'|' -> stack.pop() or stack.pop()
'!' -> !stack.pop()
'^' -> stack.pop() xor stack.pop()
else -> throw RuntimeException("Non-conformant character '$e' in expression")
}
)
}
require(stack.size == 1)
return stack.peek()
}
fun setVariables(pos: Int) {
require(pos <= variables.size)
if (pos == variables.size) {
val vs = variables.map { if (it.value) "T" else "F" }.joinToString(" ")
val es = if (evalExpression()) "T" else "F"
return println("$vs $es")
}
variables[pos].value = false
setVariables(pos + 1)
variables[pos].value = true
setVariables(pos + 1)
}
fun main(args: Array<String>) {
println("Accepts single-character variables (except for 'T' and 'F',")
println("which specify explicit true or false values), postfix, with")
println("&|!^ for and, or, not, xor, respectively; optionally")
println("seperated by spaces or tabs. Just enter nothing to quit.")
while (true) {
print("\nBoolean expression: ")
expr = readLine()!!.toUpperCase().replace(" ", "").replace("\t", "")
if (expr == "") return
variables.clear()
for (e in expr) {
if (!e.isOperator() && e !in "TF" && !e.isVariable()) variables.add(Variable(e))
}
if (variables.isEmpty()) return
val vs = variables.map { it.name }.joinToString(" ")
println("\n$vs $expr")
val h = vs.length + expr.length + 2
repeat(h) { print("=") }
println("\n")
setVariables(0)
}
}

91
Task/Truth-table/Liberty-BASIC/truth-table.basic Normal file
View file

@ -0,0 +1,91 @@
print
print " TRUTH TABLES"
print
print " Input a valid Boolean expression for creating the truth table "
print " Use lowercase 'and', 'or', 'xor', '(', 'not(' and ')'."
print
print " Take special care to precede closing bracket with a space."
print
print " You can use any alphanumeric variable names, but no spaces."
print " You can refer again to a variable used already."
print " Program assumes <8 variables will be used.."
print
print " eg 'A xor B and not( C or A )'"
print " or 'Too_High xor not( Fuel_Out )'"
print
[start]
input " "; expression$
if expression$ ="" then [start]
print
'used$ =""
numVariables =0 ' count of detected variable names
variableNames$ ="" ' filled with detected variable names
i =1 ' index to space-delimited word in the expression$
[parse]
m$ =word$( expression$, i, " ")
if m$ ="" then [analyse]
' is it a reserved word, or a variable name already met?
if m$ <>"and" and m$ <>"or" and m$ <>"not(" and m$ <>")" and m$ <>"xor"_
and not( instr( variableNames$, m$)) then
variableNames$ =variableNames$ +m$ +" ": numVariables =numVariables +1
end if
i =i +1
goto [parse]
[analyse]
for i =1 to numVariables
ex$ =FindReplace$( expression$, word$( variableNames$, i, " "), chr$( 64 +i), 1)
expression$ =ex$
next i
'print " "; numVariables; " variables, simplifying to "; expression$
print ,;
for j =1 to numVariables
print word$( variableNames$, j, " "),
next j
print "Result"
print
for i =0 to ( 2^numVariables) -1
print ,;
A =i mod 2: print A,
if numVariables >1 then B =int( i /2) mod 2: print B,
if numVariables >2 then C =int( i /4) mod 2: print C,
if numVariables >3 then D =int( i /4) mod 2: print D,
if numVariables >4 then E =int( i /4) mod 2: print E,
if numVariables >5 then F =int( i /4) mod 2: print F,
if numVariables >6 then G =int( i /4) mod 2: print G,
' .......................... etc
'e =eval( expression$)
if eval( expression$) <>0 then e$ ="1" else e$ ="0"
print "==> "; e$
next i
print
goto [start]
end
function FindReplace$( FindReplace$, find$, replace$, replaceAll)
if ( ( FindReplace$ <>"") and ( find$ <>"")) then
fLen = len( find$)
rLen = len( replace$)
do
fPos = instr( FindReplace$, find$, fPos)
if not( fPos) then exit function
pre$ = left$( FindReplace$, fPos -1)
post$ = mid$( FindReplace$, fPos +fLen)
FindReplace$ = pre$ +replace$ +post$
fPos = fPos +(rLen -fLen) +1
loop while ( replaceAll)
end if
end function

12
Task/Truth-table/Mathematica/truth-table.math Normal file
View file

@ -0,0 +1,12 @@
VariableNames[data_] := Module[ {TokenRemoved},
TokenRemoved = StringSplit[data,{"~And~","~Or~","~Xor~","!","(",")"}];
Union[Select[Map[StringTrim,TokenRemoved] , Not[StringMatchQ[#,""]]&]]
]
TruthTable[BooleanEquation_] := Module[ {TestDataSet},
TestDataSet = MapThread[Rule,{ToExpression@VariableNames[BooleanEquation],#}]&/@
Tuples[{False,True}, Length[VariableNames[BooleanEquation]]];
Join[List[Flatten[{VariableNames[BooleanEquation],BooleanEquation}]],
Flatten[{#/.Rule[x_,y_] -> y,ReplaceAll[ToExpression[BooleanEquation],#]}]&/@TestDataSet]//Grid
]

49
Task/Truth-table/Maxima/truth-table-1.maxima Normal file
View file

@ -0,0 +1,49 @@
/* Maxima already has the following logical operators
=, # (not equal), not, and, or
define some more and set 'binding power' (operator
precedence) for them
*/
infix("xor", 60)$
"xor"(A,B):= (A or B) and not(A and B)$
infix("=>", 59)$
"=>"(A,B):= not A or B$
/*
Substitute variables `r' in `e' with values taken from list `l' where
`e' is expression, `r' is a list of independent variables, `l' is a
list of the values
lsubst( '(A + B), ['A, 'B], [1, 2]);
1 + 2;
*/
lsubst(e, r, l):= ev(e, maplist( lambda([x, y], x=y), r, l), 'simp)$
/*
"Cartesian power" `n' of list `b'. Returns a list of lists of the form
[<x_1>, ..., <x_n>], were <x_1>, .. <x_n> are elements of list `b'
cartesian_power([true, false], 2);
[[true, true], [true, false], [false, true], [false, false]];
cartesian_power([true, false], 3);
[[true, true, true], [true, true, false], [true, false, true],
[true, false, false], [false, true, true], [false, true, false],
[false, false, true], [false, false, false]];
*/
cartesian_power(b, n) := block(
[aux_lst: makelist(setify(b), n)],
listify(apply(cartesian_product, aux_lst))
)$
gen_table(expr):= block(
[var_lst: listofvars(expr), st_lst, res_lst, m],
st_lst: cartesian_power([true, false], length(var_lst)),
res_lst: create_list(lsubst(expr, var_lst, val_lst), val_lst, st_lst),
m : apply('matrix, cons(var_lst, st_lst)),
addcol(m, cons(expr, res_lst))
);
/* examples */
gen_table('(not A));
gen_table('(A xor B));
gen_table('(Jim and (Spock xor Bones) or Scotty));
gen_table('(A => (B and A)));
gen_table('(V xor (B xor (K xor D ) )));

33
Task/Truth-table/Maxima/truth-table-2.maxima Normal file
View file

@ -0,0 +1,33 @@
[ V B K D V xor (B xor (K xor D)) ]
[ ]
[ true true true true false ]
[ ]
[ true true true false true ]
[ ]
[ true true false true true ]
[ ]
[ true true false false false ]
[ ]
[ true false true true true ]
[ ]
[ true false true false false ]
[ ]
[ true false false true false ]
[ ]
[ true false false false true ]
[ ]
[ false true true true true ]
[ ]
[ false true true false false ]
[ ]
[ false true false true false ]
[ ]
[ false true false false true ]
[ ]
[ false false true true false ]
[ ]
[ false false true false true ]
[ ]
[ false false false true true ]
[ ]
[ false false false false false ]

94
Task/Truth-table/Nim/truth-table.nim Normal file
View file

@ -0,0 +1,94 @@
import sequtils, strutils, sugar
# List of possible variables names.
const VarChars = {'A'..'E', 'G'..'S', 'U'..'Z'}
type
Expression = object
names: seq[char] # List of variables names.
values: seq[bool] # Associated values.
formula: string # Formula as a string.
proc initExpression(str: string): Expression =
## Build an expression from a string.
for ch in str:
if ch in VarChars and ch notin result.names:
result.names.add ch
result.values.setLen(result.names.len)
result.formula = str
template apply(stack: seq[bool]; op: (bool, bool) -> bool): bool =
## Apply an operator on the last two operands of an evaluation stack.
## Needed to make sure that pops are done (avoiding short-circuit optimization).
let op2 = stack.pop()
let op1 = stack.pop()
op(op1, op2)
proc evaluate(expr: Expression): bool =
## Evaluate the current expression.
var stack: seq[bool] # Evaluation stack.
for e in expr.formula:
stack.add case e
of 'T': true
of 'F': false
of '!': not stack.pop()
of '&': stack.apply(`and`)
of '|': stack.apply(`or`)
of '^': stack.apply(`xor`)
else:
if e in VarChars: expr.values[expr.names.find(e)]
else:
raise newException(
ValueError, "Non-conformant character in expression: '$#'.".format(e))
if stack.len != 1:
raise newException(ValueError, "Ill-formed expression.")
result = stack[0]
proc setVariables(expr: var Expression; pos: Natural) =
## Recursively set the variables.
## When all the variables are set, launch the evaluation of the expression
## and print the result.
assert pos <= expr.values.len
if pos == expr.values.len:
# Evaluate and display.
let vs = expr.values.mapIt(if it: 'T' else: 'F').join(" ")
let es = if expr.evaluate(): 'T' else: 'F'
echo vs, " ", es
else:
# Set values.
expr.values[pos] = false
expr.setVariables(pos + 1)
expr.values[pos] = true
expr.setVariables(pos + 1)
echo "Accepts single-character variables (except for 'T' and 'F',"
echo "which specify explicit true or false values), postfix, with"
echo "&|!^ for and, or, not, xor, respectively; optionally"
echo "seperated by spaces or tabs. Just enter nothing to quit."
while true:
# Read formula and create expression.
stdout.write "\nBoolean expression: "
let line = stdin.readLine.toUpperAscii.multiReplace((" ", ""), ("\t", ""))
if line.len == 0: break
var expr = initExpression(line)
if expr.names.len == 0: break
# Display the result.
let vs = expr.names.join(" ")
echo '\n', vs, " ", expr.formula
let h = vs.len + expr.formula.len + 2
echo repeat('=', h)
expr.setVariables(0)

23
Task/Truth-table/PARI-GP/truth-table.parigp Normal file
View file

@ -0,0 +1,23 @@
vars(P)={
my(v=List(),x);
while(type(P)=="t_POL",
x=variable(P);
listput(v,x);
P=subst(P,x,1)
);
Vec(v)
};
truthTable(P)={
my(var=vars(P),t,b);
for(i=0,2^#var-1,
t=eval(P);
for(j=1,#var,
b=bittest(i,j-1);
t=subst(t,var[j],b);
print1(b)
);
print(!!t)
);
};
truthTable("x+y") \\ OR
truthTable("x*y") \\ AND

234
Task/Truth-table/Pascal/truth-table.pas Normal file
View file

@ -0,0 +1,234 @@
program TruthTables;
const
StackSize = 80;
type
TVariable = record
Name: Char;
Value: Boolean;
end;
TStackOfBool = record
Top: Integer;
Elements: array [0 .. StackSize - 1] of Boolean;
end;
var
Expression: string;
Variables: array [0 .. 23] of TVariable;
VariablesLength: Integer;
i: Integer;
e: Char;
// Stack manipulation functions
function IsFull(var s: TStackOfBool): Boolean;
begin
IsFull := s.Top = StackSize - 1;
end;
function IsEmpty(var s: TStackOfBool): Boolean;
begin
IsEmpty := s.Top = -1;
end;
function Peek(var s: TStackOfBool): Boolean;
begin
if not IsEmpty(s) then
Peek := s.Elements[s.Top]
else
begin
Writeln('Stack is empty.');
Halt;
end;
end;
procedure Push(var s: TStackOfBool; val: Boolean);
begin
if not IsFull(s) then
begin
Inc(s.Top);
s.Elements[s.Top] := val;
end
else
begin
Writeln('Stack is full.');
Halt;
end
end;
function Pop(var s: TStackOfBool): Boolean;
begin
if not IsEmpty(s) then
begin
Result := s.Elements[s.Top];
Dec(s.Top);
end
else
begin
Writeln;
Writeln('Stack is empty.');
Halt;
end
end;
procedure MakeEmpty(var s: TStackOfBool);
begin
s.Top := -1;
end;
function ElementsCount(var s: TStackOfBool): Integer;
begin
ElementsCount := s.Top + 1;
end;
function IsOperator(const c: Char): Boolean;
begin
IsOperator := (c = '&') or (c = '|') or (c = '!') or (c = '^');
end;
function VariableIndex(const c: Char): Integer;
var
i: Integer;
begin
for i := 0 to VariablesLength - 1 do
if Variables[i].Name = c then
begin
VariableIndex := i;
Exit;
end;
VariableIndex := -1;
end;
function EvaluateExpression: Boolean;
var
i, vi: Integer;
e: Char;
s: TStackOfBool;
begin
MakeEmpty(s);
for i := 1 to Length(Expression) do
begin
e := Expression[i];
vi := VariableIndex(e);
if e = 'T' then
Push(s, True)
else if e = 'F' then
Push(s, False)
else if vi >= 0 then
Push(s, Variables[vi].Value)
else
begin
{$B+}
case e of
'&':
Push(s, Pop(s) and Pop(s));
'|':
Push(s, Pop(s) or Pop(s));
'!':
Push(s, not Pop(s));
'^':
Push(s, Pop(s) xor Pop(s));
else
Writeln;
Writeln('Non-conformant character ', e, ' in expression.');
Halt;
end;
{$B-}
end;
end;
if ElementsCount(s) <> 1 then
begin
Writeln;
Writeln('Stack should contain exactly one element.');
Halt;
end;
EvaluateExpression := Peek(s);
end;
procedure SetVariables(pos: Integer);
var
i: Integer;
begin
if pos > VariablesLength then
begin
Writeln;
Writeln('Argument to SetVariables cannot be greater than the number of variables.');
Halt;
end
else if pos = VariablesLength then
begin
for i := 0 to VariablesLength - 1 do
begin
if Variables[i].Value then
Write('T ')
else
Write('F ');
end;
if EvaluateExpression then
Writeln('T')
else
Writeln('F');
end
else
begin
Variables[pos].Value := False;
SetVariables(pos + 1);
Variables[pos].Value := True;
SetVariables(pos + 1);
end
end;
// removes space and converts to upper case
procedure ProcessExpression;
var
i: Integer;
exprTmp: string;
begin
exprTmp := '';
for i := 1 to Length(Expression) do
begin
if Expression[i] <> ' ' then
exprTmp := Concat(exprTmp, UpCase(Expression[i]));
end;
Expression := exprTmp
end;
begin
Writeln('Accepts single-character variables (except for ''T'' and ''F'',');
Writeln('which specify explicit true or false values), postfix, with');
Writeln('&|!^ for and, or, not, xor, respectively; optionally');
Writeln('seperated by space. Just enter nothing to quit.');
while (True) do
begin
Writeln;
Write('Boolean expression: ');
ReadLn(Expression);
ProcessExpression;
if Length(Expression) = 0 then
Break;
VariablesLength := 0;
for i := 1 to Length(Expression) do
begin
e := Expression[i];
if (not IsOperator(e)) and (e <> 'T') and (e <> 'F') and
(VariableIndex(e) = -1) then
begin
Variables[VariablesLength].Name := e;
Variables[VariablesLength].Value := False;
Inc(VariablesLength);
end;
end;
WriteLn;
if VariablesLength = 0 then
Writeln('No variables were entered.')
else
begin
for i := 0 to VariablesLength - 1 do
Write(Variables[i].Name, ' ');
Writeln(Expression);
Writeln(StringOfChar('=', VariablesLength * 3 + Length(Expression)));
SetVariables(0);
end;
end;
end.

21
Task/Truth-table/Perl/truth-table.pl Normal file
View file

@ -0,0 +1,21 @@
#!/usr/bin/perl
sub truth_table {
my $s = shift;
my (%seen, @vars);
for ($s =~ /([a-zA-Z_]\w*)/g) {
$seen{$_} //= do { push @vars, $_; 1 };
}
print "\n", join("\t", @vars, $s), "\n", '-' x 40, "\n";
@vars = map("\$$_", @vars);
$s =~ s/([a-zA-Z_]\w*)/\$$1/g;
$s = "print(".join(',"\t", ', map("($_?'T':'F')", @vars, $s)).",\"\\n\")";
$s = "for my $_ (0, 1) { $s }" for (reverse @vars);
eval $s;
}
truth_table 'A ^ A_1';
truth_table 'foo & bar | baz';
truth_table 'Jim & (Spock ^ Bones) | Scotty';

188
Task/Truth-table/Phix/truth-table.phix Normal file
View file

@ -0,0 +1,188 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">bFT</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">false</span> <span style="color: #000080;font-style:italic;">-- true: use F/T, false: use 0/1, as next</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">fmt</span><span style="color: #0000FF;">(</span><span style="color: #004080;">bool</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bFT</span><span style="color: #0000FF;">?{</span><span style="color: #008000;">"F"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"T"</span><span style="color: #0000FF;">}:{</span><span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"1"</span><span style="color: #0000FF;">})[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">opstack</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> <span style="color: #000080;font-style:italic;">-- 0 = none</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">s</span> <span style="color: #000080;font-style:italic;">-- the expression being parsed</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">sidx</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- idx to ""</span>
<span style="color: #000000;">ch</span> <span style="color: #000080;font-style:italic;">-- s[sidx]</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">err</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">msg</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s\n%s^ %s\n\nPressEnter..."</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">),</span><span style="color: #000000;">msg</span><span style="color: #0000FF;">})</span>
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">wait_key</span><span style="color: #0000FF;">()</span>
<span style="color: #7060A8;">abort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">sidx</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">></span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)?-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">:</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">skipspaces</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">while</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" \t\r\n"</span><span style="color: #0000FF;">)!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span> <span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">skipspaces</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"()!"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">token</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">..</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">else</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">tokstart</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">sidx</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000000;">token</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"eof"</span> <span style="color: #008080;">return</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;"><</span><span style="color: #008000;">'A'</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #000000;">token</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">tokstart</span><span style="color: #0000FF;">..</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">Match</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">t</span> <span style="color: #008080;">then</span> <span style="color: #000000;">err</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">&</span><span style="color: #008000;">" expected"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">p2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">opstack</span><span style="color: #0000FF;">[$]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"not"</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">opstack</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">p2</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">opstack</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">opstack</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..$-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">opstack</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">opstack</span><span style="color: #0000FF;">[$],</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">p2</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">names</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- {"false","true",...}</span>
<span style="color: #000000;">flags</span> <span style="color: #000080;font-style:italic;">-- { 0, 1, ,...}</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">PushFactor</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">,</span><span style="color: #000000;">names</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">names</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">,</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">opstack</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opstack</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">PushOp</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">forward</span> <span style="color: #008080;">procedure</span> <span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">Factor</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"not"</span>
<span style="color: #008080;">or</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"!"</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">Factor</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">PushOp</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"not"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"("</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">Match</span><span style="color: #0000FF;">(</span><span style="color: #008000;">")"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">elsif</span> <span style="color: #008080;">not</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">token</span><span style="color: #0000FF;">,{</span><span style="color: #008000;">"and"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"or"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"xor"</span><span style="color: #0000FF;">})</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">PushFactor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">token</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">!=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">err</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"syntax error"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">constant</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">operators</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">precedence</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">columnize</span><span style="color: #0000FF;">({{</span><span style="color: #008000;">"not"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">6</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"and"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"xor"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"or"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">}})</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">Factor</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">token</span><span style="color: #0000FF;">,</span><span style="color: #000000;">operators</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">thisp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">precedence</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">thisp</span><span style="color: #0000FF;"><</span><span style="color: #000000;">p</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">thisp</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">PushOp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">operators</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">evaluate</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">atom</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">s</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">lhs</span><span style="color: #0000FF;">,</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">rhs</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span>
<span style="color: #000000;">lhs</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">evaluate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">lhs</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">rhs</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">evaluate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">rhs</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"and"</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">lhs</span> <span style="color: #008080;">and</span> <span style="color: #000000;">rhs</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"or"</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">lhs</span> <span style="color: #008080;">or</span> <span style="color: #000000;">rhs</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"xor"</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">lhs</span> <span style="color: #008080;">xor</span> <span style="color: #000000;">rhs</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"not"</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #008080;">not</span> <span style="color: #000000;">rhs</span>
<span style="color: #008080;">else</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">next_comb</span><span style="color: #0000FF;">()</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">fdx</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">flags</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">fdx</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">fdx</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #000000;">fdx</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">fdx</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #004600;">false</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #000080;font-style:italic;">-- all done</span>
<span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">fdx</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">expr</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">opstack</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #000000;">names</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"false"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"true"</span><span style="color: #0000FF;">}</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">expr</span>
<span style="color: #000000;">sidx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opstack</span><span style="color: #0000FF;">)!=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000000;">err</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"some error"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">flags</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">))</span>
<span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span> <span style="color: #000080;font-style:italic;">-- set "true" true</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">..$]),</span><span style="color: #000000;">s</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">3</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">flags</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> <span style="color: #000080;font-style:italic;">-- (skipping true&false)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s%s"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">fmt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]),</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]))})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">fmt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">evaluate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opstack</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]))})</span>
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">next_comb</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"young and not (ugly or poor)"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()!=</span><span style="color: #004600;">JS</span> <span style="color: #008080;">then</span> <span style="color: #000080;font-style:italic;">-- (no gets(0) in a browser)</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"input expression:"</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">trim</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">gets</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">))</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">=</span><span style="color: #008000;">""</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<!--

24
Task/Truth-table/PicoLisp/truth-table-1.l Normal file
View file

@ -0,0 +1,24 @@
(de truthTable (Expr)
(let Vars
(uniq
(make
(setq Expr
(recur (Expr) # Convert infix to prefix notation
(cond
((atom Expr) (link Expr))
((== 'not (car Expr))
(list 'not (recurse (cadr Expr))) )
(T
(list
(cadr Expr)
(recurse (car Expr))
(recurse (caddr Expr)) ) ) ) ) ) ) )
(for V Vars
(prin (align -7 V)) )
(prinl)
(bind (mapcar cons Vars)
(do (** 2 (length Vars))
(for "V" Vars
(space (if (print (val "V")) 6 4)) )
(println (eval Expr))
(find '(("V") (set "V" (not (val "V")))) Vars) ) ) ) )

43
Task/Truth-table/PicoLisp/truth-table-2.l Normal file
View file

@ -0,0 +1,43 @@
: (truthTable (str "A and (B or C)"))
A B C
NIL NIL NIL NIL
T NIL NIL NIL
NIL T NIL NIL
T T NIL T
NIL NIL T NIL
T NIL T T
NIL T T NIL
T T T T
: (truthTable (str "not (Foo and (Bar or Mumble))"))
Foo Bar Mumble
NIL NIL NIL T
T NIL NIL T
NIL T NIL T
T T NIL NIL
NIL NIL T T
T NIL T NIL
NIL T T T
T T T NIL
: (truthTable (str "(A xor B) and (B or C)"))
A B C
NIL NIL NIL NIL
T NIL NIL NIL
NIL T NIL T
T T NIL NIL
NIL NIL T NIL
T NIL T T
NIL T T T
T T T NIL
: (truthTable (str "(A xor B) and ((not B) or C)"))
A B C
NIL NIL NIL NIL
T NIL NIL T
NIL T NIL NIL
T T NIL NIL
NIL NIL T NIL
T NIL T T
NIL T T T
T T T NIL

99
Task/Truth-table/Prolog/truth-table.pro Normal file
View file

@ -0,0 +1,99 @@
/*
To evaluate the truth table a line of text is inputted and then there are three steps
Let's say the expression is:
'not a and (b or c)'
Step 1: tokenize into atoms and brackets
eg: Tokenized = [ not, a, and, '(', b, or, c, ')' ].
Step 2: convert to a term that can be evaluated, and get out the variables
eg: Expression = op(and, op(not, a), op(or, b, c)), Variables = [ a, b, c ]
Step 3: permeate over the variables, substituting the values for each var, and evaluate the expression for each permutation
eg: [ 0, 0, 0]
op(and, op(not, 0), op(or, 0, 0))
op(and, 1, op(or, 0, 0))
op(and, 1, 0)
0
[ 0, 0, 1]
op(and, op(not, 0), op(or, 0, 1))
op(and, 1, op(or, 0, 0))
op(and, 1, 1)
1
*/
truth_table :-
current_input(In),
read_line_to_codes(In, Line),
atom_codes(A, Line),
atom_chars(A, Chars),
% parse everything into the form we want
phrase(tok(Tok), Chars, _),
phrase(expr(Expr,Vars), Tok, _),
list_to_set(Vars,VarSet),
% evaluate
print_expr(Expr, VarSet), !.
print_expr(Expr, Vars) :-
% write the header (once)
maplist(format('~p '), Vars),
format('~n'),
% write the results for as many times as there are rows
eval_expr(Expr, Vars, Tvals, R),
maplist(format('~p '), Tvals),
format('~p~n', R),
fail.
print_expr(_, _).
% Step 1 - tokenize the input into spaces, brackets and atoms
tok([A|As]) --> spaces(_), chars([X|Xs]), {atom_codes(A, [X|Xs])}, spaces(_), tok(As).
tok([A|As]) --> spaces(_), bracket(A), spaces(_), tok(As).
tok([]) --> [].
chars([X|Xs]) --> char(X), { dif(X, ')'), dif(X, '(') }, !, chars(Xs).
chars([]) --> [].
spaces([X|Xs]) --> space(X), !, spaces(Xs).
spaces([]) --> [].
bracket('(') --> ['('].
bracket(')') --> [')'].
% Step 2 - Parse the expression into an evaluable term
expr(op(I, E, E2), V) --> starter(E, V1), infix(I), expr(E2, V2), { append(V1, V2, V) }.
expr(E, V) --> starter(E, V).
starter(op(not, E),V) --> [not], expr(E, V).
starter(E,V) --> ['('], expr(E,V), [')'].
starter(V,[V]) --> variable(V).
infix(or) --> [or].
infix(and) --> [and].
infix(xor) --> [xor].
infix(nand) --> [nand].
variable(V) --> [V], \+ infix(V), \+ bracket(V).
space(' ') --> [' '].
char(X) --> [X], { dif(X, ' ') }.
% Step 3 - evaluate the parsed expression
eval_expr(Expr, Vars, Tvals, R) :-
length(Vars,Len),
length(Tvals, Len),
maplist(truth_val, Tvals),
eval(Expr, [Tvals,Vars],R).
eval(X, [Vals,Vars], R) :- nth1(N,Vars,X), nth1(N,Vals,R).
eval(op(Op,A,B), V, R) :- eval(A,V,Ae), eval(B,V,Be), e(Op,Ae,Be,R).
eval(op(not,A), V, R) :- eval(A,V,Ae), e(not,Ae,R).
truth_val(0). truth_val(1).
e(or,0,0,0). e(or,0,1,1). e(or,1,0,1). e(or,1,1,1).
e(and,0,0,0). e(and,0,1,0). e(and,1,0,0). e(and,1,1,1).
e(xor,0,0,0). e(xor,0,1,1). e(xor,1,0,1). e(xor,1,1,0).
e(nand,0,0,1). e(nand,0,1,1). e(nand,1,0,1). e(nand,1,1,0).
e(not, 1, 0). e(not, 0, 1).

14
Task/Truth-table/Python/truth-table.py Normal file
View file

@ -0,0 +1,14 @@
from itertools import product
while True:
bexp = input('\nBoolean expression: ')
bexp = bexp.strip()
if not bexp:
print("\nThank you")
break
code = compile(bexp, '<string>', 'eval')
names = code.co_names
print('\n' + ' '.join(names), ':', bexp)
for values in product(range(2), repeat=len(names)):
env = dict(zip(names, values))
print(' '.join(str(v) for v in values), ':', eval(code, env))

41
Task/Truth-table/Quackery/truth-table.quackery Normal file
View file

@ -0,0 +1,41 @@
[ stack ] is args ( --> s )
[ stack ] is results ( --> s )
[ stack ] is function ( --> s )
[ args share times
[ sp
2 /mod iff
[ char t ]
else
[ char f ]
emit ]
drop
say " | " ] is echoargs ( n --> )
[ args share times
[ 2 /mod swap ]
drop ] is preparestack ( n --> b*n )
[ results share times
[ sp
iff
[ char t ]
else
[ char f ]
emit ] ] is echoresults ( b*? --> )
[ say "Please input your function, preceded" cr
$ "by the number of arguments and results: " input
trim nextword quackery args put
trim nextword quackery results put
trim build function put
args share bit times
[ cr
i^ echoargs
i^ preparestack
function share do
echoresults ]
cr
args release
results release
function release ] is truthtable ( --> )

66
Task/Truth-table/R/truth-table.r Normal file
View file

@ -0,0 +1,66 @@
truth_table <- function(x) {
vars <- unique(unlist(strsplit(x, "[^a-zA-Z]+")))
vars <- vars[vars != ""]
perm <- expand.grid(rep(list(c(FALSE, TRUE)), length(vars)))
names(perm) <- vars
perm[ , x] <- with(perm, eval(parse(text = x)))
perm
}
"%^%" <- xor # define unary xor operator
truth_table("!A") # not
## A !A
## 1 FALSE TRUE
## 2 TRUE FALSE
truth_table("A | B") # or
## A B A | B
## 1 FALSE FALSE FALSE
## 2 TRUE FALSE TRUE
## 3 FALSE TRUE TRUE
## 4 TRUE TRUE TRUE
truth_table("A & B") # and
## A B A & B
## 1 FALSE FALSE FALSE
## 2 TRUE FALSE FALSE
## 3 FALSE TRUE FALSE
## 4 TRUE TRUE TRUE
truth_table("A %^% B") # xor
## A B A %^% B
## 1 FALSE FALSE FALSE
## 2 TRUE FALSE TRUE
## 3 FALSE TRUE TRUE
## 4 TRUE TRUE FALSE
truth_table("S | (T %^% U)") # 3 variables with brackets
## S T U S | (T %^% U)
## 1 FALSE FALSE FALSE FALSE
## 2 TRUE FALSE FALSE TRUE
## 3 FALSE TRUE FALSE TRUE
## 4 TRUE TRUE FALSE TRUE
## 5 FALSE FALSE TRUE TRUE
## 6 TRUE FALSE TRUE TRUE
## 7 FALSE TRUE TRUE FALSE
## 8 TRUE TRUE TRUE TRUE
truth_table("A %^% (B %^% (C %^% D))") # 4 variables with nested brackets
## A B C D A %^% (B %^% (C %^% D))
## 1 FALSE FALSE FALSE FALSE FALSE
## 2 TRUE FALSE FALSE FALSE TRUE
## 3 FALSE TRUE FALSE FALSE TRUE
## 4 TRUE TRUE FALSE FALSE FALSE
## 5 FALSE FALSE TRUE FALSE TRUE
## 6 TRUE FALSE TRUE FALSE FALSE
## 7 FALSE TRUE TRUE FALSE FALSE
## 8 TRUE TRUE TRUE FALSE TRUE
## 9 FALSE FALSE FALSE TRUE TRUE
## 10 TRUE FALSE FALSE TRUE FALSE
## 11 FALSE TRUE FALSE TRUE FALSE
## 12 TRUE TRUE FALSE TRUE TRUE
## 13 FALSE FALSE TRUE TRUE FALSE
## 14 TRUE FALSE TRUE TRUE TRUE
## 15 FALSE TRUE TRUE TRUE TRUE
## 16 TRUE TRUE TRUE TRUE FALSE

236
Task/Truth-table/REXX/truth-table.rexx Normal file
View file

@ -0,0 +1,236 @@
/*REXX program displays a truth table of variables and an expression. Infix notation */
/*─────────────── is supported with one character propositional constants; variables */
/*─────────────── (propositional constants) that are allowed: A──►Z, a──►z except u.*/
/*─────────────── All propositional constants are case insensitive (except lowercase u).*/
parse arg userText /*get optional expression from the CL. */
if userText\='' then do /*Got one? Then show user's stuff. */
call truthTable userText /*display truth table for the userText.*/
exit /*we're finished with the user's text. */
end
call truthTable "G ^ H ; XOR" /*text after ; is echoed to the output.*/
call truthTable "i | j ; OR"
call truthTable "G nxor H ; NXOR"
call truthTable "k ! t ; NOR"
call truthTable "p & q ; AND"
call truthTable "e ¡ f ; NAND"
call truthTable "S | (T ^ U)"
call truthTable "(p=>q) v (q=>r)"
call truthTable "A ^ (B ^ (C ^ D))"
exit /*quit while we're ahead, by golly. */
/* ↓↓↓ no way, Jose. ↓↓↓ */ /* [↓] shows a 32,768 line truth table*/
call truthTable "A^ (B^ (C^ (D^ (E^ (F^ (G^ (H^ (I^ (J^ (L^ (L^ (M^ (N^O) ))))))))))))"
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
truthTable: procedure; parse arg $ ';' comm 1 $o; $o= strip($o); hdrPCs=
$= translate(strip($), '|', "v"); $u= $; upper $u
$u= translate($u, '()()()', "[]{}«»"); $$.= 0; PCs=
@abc= 'abcdefghijklmnopqrstuvwxyz'; @abcU= @abc; upper @abcU
/* ╔═════════════════════╦════════════════════════════════════════════════════════════╗
║ ║ bool(bitsA, bitsB, BF) ║
║ ╟────────────────────────────────────────────────────────────╢
║ ║ performs the boolean function BF ┌──────┬─────────┐ ║
║ ║ on the A bitstring │ BF │ common │ ║
║ ║ with the B bitstring. │ value│ name │ ║
║ ║ ├──────┼─────────┤ ║
║ ║ BF must be a one to four bit │ 0000 │boolfalse│ ║
║ ║ value (from 0000 ──► 1111), │ 0001 │ and │ ║
║ This boxed table ║ leading zeroes can be omitted. │ 0010 │ NaIMPb │ ║
║ was re─constructed ║ │ 0011 │ boolB │ ║
║ from an old IBM ║ BF may have multiple values (one │ 0100 │ NbIMPa │ ║
║ publicastion: ║ for each pair of bitstrings): │ 0101 │ boolA │ ║
║ ║ │ 0110 │ xor │ ║
║ "PL/I Language ║ ┌──────┬──────┬───────────────┐ │ 0111 │ or │ ║
║ Specifications" ║ │ Abit │ Bbit │ returns │ │ 1000 │ nor │ ║
║ ║ ├──────┼──────┼───────────────┤ │ 1001 │ nxor │ ║
║ ║ │ 0 │ 0 │ 1st bit in BF │ │ 1010 │ notB │ ║
║ ║ │ 0 │ 1 │ 2nd bit in BF │ │ 1011 │ bIMPa │ ║
║ ─── March 1969. ║ │ 1 │ 0 │ 3rd bit in BF │ │ 1100 │ notA │ ║
║ ║ │ 1 │ 1 │ 4th bit in BF │ │ 1101 │ aIMPb │ ║
║ ║ └──────┴──────┴───────────────┘ │ 1110 │ nand │ ║
║ ║ │ 1111 │booltrue │ ║
║ ║ ┌──┴──────┴─────────┤ ║
║ ║ │ A 0101 │ ║
║ ║ │ B 0011 │ ║
║ ║ └───────────────────┘ ║
╚═════════════════════╩════════════════════════════════════════════════════════════╝ */
@= 'ff'x /* [↓] ───── infix operators (0──►15) */
op.= /*Note: a single quote (') wasn't */
/* implemented for negation.*/
op.0 = 'false boolFALSE' /*unconditionally FALSE */
op.1 = '& and *' /* AND, conjunction */
op.2 = 'naimpb NaIMPb' /*not A implies B */
op.3 = 'boolb boolB' /*B (value of) */
op.4 = 'nbimpa NbIMPa' /*not B implies A */
op.5 = 'boola boolA' /*A (value of) */
op.6 = '&& xor % ^' /* XOR, exclusive OR */
op.7 = '| or + v' /* OR, disjunction */
op.8 = 'nor nor ! ↓' /* NOR, not OR, Pierce operator */
op.9 = 'xnor xnor nxor' /*NXOR, not exclusive OR, not XOR */
op.10= 'notb notB' /*not B (value of) */
op.11= 'bimpa bIMPa' /* B implies A */
op.12= 'nota notA' /*not A (value of) */
op.13= 'aimpb aIMPb' /* A implies B */
op.14= 'nand nand ¡ ↑' /*NAND, not AND, Sheffer operator */
op.15= 'true boolTRUE' /*unconditionally TRUE */
/*alphabetic names that need changing. */
op.16= '\ NOT ~ ─ . ¬' /* NOT, negation */
op.17= '> GT' /*conditional */
op.18= '>= GE ─> => ──> ==>' "1a"x /*conditional; (see note below.)──┐*/
op.19= '< LT' /*conditional │*/
op.20= '<= LE <─ <= <── <==' /*conditional │*/
op.21= '\= NE ~= ─= .= ¬=' /*conditional │*/
op.22= '= EQ EQUAL EQUALS =' "1b"x /*bi─conditional; (see note below.)┐ │*/
op.23= '0 boolTRUE' /*TRUEness │ │*/
op.24= '1 boolFALSE' /*FALSEness ↓ ↓*/
/* [↑] glphys '1a'x and "1b"x can't*/
/* displayed under most DOS' & such*/
do jj=0 while op.jj\=='' | jj<16 /*change opers ──► into what REXX likes*/
new= word(op.jj, 1) /*obtain the 1st token of infex table.*/
/* [↓] process the rest of the tokens.*/
do kk=2 to words(op.jj) /*handle each of the tokens separately.*/
_=word(op.jj, kk); upper _ /*obtain another token from infix table*/
if wordpos(_, $u)==0 then iterate /*no such animal in this string. */
if datatype(new, 'm') then new!= @ /*it needs to be transcribed*/
else new!= new /*it doesn't need " " " */
$u= changestr(_, $u, new!) /*transcribe the function (maybe). */
if new!==@ then $u= changeFunc($u,@,new) /*use the internal boolean name. */
end /*kk*/
end /*jj*/
$u=translate($u, '()', "{}") /*finish cleaning up the transcribing. */
do jj=1 for length(@abcU) /*see what variables are being used. */
_= substr(@abcU, jj, 1) /*use the available upercase aLphabet. */
if pos(_,$u) == 0 then iterate /*Found one? No, then keep looking. */
$$.jj= 1 /*found: set upper bound for it. */
PCs= PCs _ /*also, add to propositional constants.*/
hdrPCs=hdrPCS center(_,length('false')) /*build a PC header for transcribing. */
end /*jj*/
ptr= '_────►_' /*a (text) pointer for the truth table.*/
$u= PCs '('$u")" /*separate the PCs from expression. */
hdrPCs= substr(hdrPCs, 2) /*create a header for the PCs. */
say hdrPCs left('', length(ptr) - 1) $o /*display PC header and expression. */
say copies('───── ', words(PCs)) left('', length(ptr) -2) copies('─', length($o))
/*Note: "true"s: are right─justified.*/
do a=0 to $$.1
do b=0 to $$.2
do c=0 to $$.3
do d=0 to $$.4
do e=0 to $$.5
do f=0 to $$.6
do g=0 to $$.7
do h=0 to $$.8
do i=0 to $$.9
do j=0 to $$.10
do k=0 to $$.11
do l=0 to $$.12
do m=0 to $$.13
do n=0 to $$.14
do o=0 to $$.15
do p=0 to $$.16
do q=0 to $$.17
do r=0 to $$.18
do s=0 to $$.19
do t=0 to $$.20
do u=0 to $$.21
do !=0 to $$.22
do w=0 to $$.23
do x=0 to $$.24
do y=0 to $$.25
do z=0 to $$.26; interpret '_=' $u
/*evaluate truth T.*/
_= changestr(1, _, '_true') /*convert 1──►_true*/
_= changestr(0, _, 'false') /*convert 0──►false*/
_= insert(ptr, _, wordindex(_, words(_) ) - 1)
say translate(_, , '_') /*display truth tab*/
end /*z*/
end /*y*/
end /*x*/
end /*w*/
end /*v*/
end /*u*/
end /*t*/
end /*s*/
end /*r*/
end /*q*/
end /*p*/
end /*o*/
end /*n*/
end /*m*/
end /*l*/
end /*k*/
end /*j*/
end /*i*/
end /*h*/
end /*g*/
end /*f*/
end /*e*/
end /*d*/
end /*c*/
end /*b*/
end /*a*/
say; say
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
scan: procedure; parse arg x,at; L= length(x); t=L; Lp=0; apost=0; quote=0
if at<0 then do; t=1; x= translate(x, '()', ")(")
end /* [↓] get 1 or 2 chars at location J*/
do j=abs(at) to t by sign(at); _=substr(x, j ,1); __=substr(x, j, 2)
if quote then do; if _\=='"' then iterate
if __=='""' then do; j= j+1; iterate; end
quote=0; iterate
end
if apost then do; if _\=="'" then iterate
if __=="''" then do; j= j+1; iterate; end
apost=0; iterate
end
if _== '"' then do; quote=1; iterate; end
if _== "'" then do; apost=1; iterate; end
if _== ' ' then iterate
if _== '(' then do; Lp= Lp+1; iterate; end
if Lp\==0 then do; if _==')' then Lp= Lp-1; iterate; end
if datatype(_, 'U') then return j - (at<0)
if at<0 then return j + 1 /*is _ uppercase ? */
end /*j*/
return min(j, L)
/*──────────────────────────────────────────────────────────────────────────────────────*/
changeFunc: procedure; parse arg z, fC, newF ; funcPos= 0
do forever
funcPos= pos(fC, z, funcPos + 1); if funcPos==0 then return z
origPos= funcPos
z= changestr(fC, z, ",'"newF"',") /*arg 3 ≡ ",'" || newF || "-'," */
funcPos= funcPos + length(newF) + 4
where= scan(z, funcPos) ; z= insert( '}', z, where)
where= scan(z, 1 - origPos) ; z= insert('bool{', z, where)
end /*forever*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
bool: procedure; arg a,?,b /* ◄─── ARG uppercases all args.*/
select /*SELECT chooses which function.*/
/*0*/ when ? == 'FALSE' then return 0
/*1*/ when ? == 'AND' then return a & b
/*2*/ when ? == 'NAIMPB' then return \ (\a & \b)
/*3*/ when ? == 'BOOLB' then return b
/*4*/ when ? == 'NBIMPA' then return \ (\b & \a)
/*5*/ when ? == 'BOOLA' then return a
/*6*/ when ? == 'XOR' then return a && b
/*7*/ when ? == 'OR' then return a | b
/*8*/ when ? == 'NOR' then return \ (a | b)
/*9*/ when ? == 'XNOR' then return \ (a && b)
/*a*/ when ? == 'NOTB' then return \ b
/*b*/ when ? == 'BIMPA' then return \ (b & \a)
/*c*/ when ? == 'NOTA' then return \ a
/*d*/ when ? == 'AIMPB' then return \ (a & \b)
/*e*/ when ? == 'NAND' then return \ (a & b)
/*f*/ when ? == 'TRUE' then return 1
otherwise return -13
end /*select*/ /* [↑] error, unknown function.*/

28
Task/Truth-table/Racket/truth-table.rkt Normal file
View file

@ -0,0 +1,28 @@
#lang racket
(define (collect-vars sexpr)
(sort
(remove-duplicates
(let loop ([x sexpr])
(cond [(boolean? x) '()]
[(symbol? x) (list x)]
[(list? x) (append-map loop (cdr x))]
[else (error 'truth-table "Bad expression: ~e" x)])))
string<? #:key symbol->string))
(define ns (make-base-namespace))
(define (truth-table sexpr)
(define vars (collect-vars sexpr))
(printf "~a => ~s\n" (string-join (map symbol->string vars)) sexpr)
(for ([i (expt 2 (length vars))])
(define vals
(map (λ(x) (eq? #\1 x))
(reverse (string->list (~r i #:min-width (length vars)
#:pad-string "0"
#:base 2)))))
(printf "~a => ~a\n" (string-join (map (λ(b) (if b "T" "F")) vals))
(if (eval `(let (,@(map list vars vals)) ,sexpr) ns) "T" "F"))))
(printf "Enter an expression: ")
(truth-table (read))

10
Task/Truth-table/Raku/truth-table.raku Normal file
View file

@ -0,0 +1,10 @@
use MONKEY-SEE-NO-EVAL;
sub MAIN ($x) {
my @n = $x.comb(/<ident>/);
my &fun = EVAL "-> {('\\' «~« @n).join(',')} \{ [{ (|@n,"so $x").join(',') }] \}";
say (|@n,$x).join("\t");
.join("\t").say for map &fun, flat map { .fmt("\%0{+@n}b").comb».Int».so }, 0 ..^ 2**@n;
say '';
}

26
Task/Truth-table/Ruby/truth-table.rb Normal file
View file

@ -0,0 +1,26 @@
loop do
print "\ninput a boolean expression (e.g. 'a & b'): "
expr = gets.strip.downcase
break if expr.empty?
vars = expr.scan(/\p{Alpha}+/)
if vars.empty?
puts "no variables detected in your boolean expression"
next
end
vars.each {|v| print "#{v}\t"}
puts "| #{expr}"
prefix = []
suffix = []
vars.each do |v|
prefix << "[false, true].each do |#{v}|"
suffix << "end"
end
body = vars.inject("puts ") {|str, v| str + "#{v}.to_s + '\t' + "}
body += '"| " + eval(expr).to_s'
eval (prefix + [body] + suffix).join("\n")
end

434
Task/Truth-table/Rust/truth-table.rust Normal file
View file

@ -0,0 +1,434 @@
use std::{
collections::HashMap,
fmt::{Display, Formatter},
iter::FromIterator,
};
// Generic expression evaluation automaton and expression formatting support
#[derive(Clone, Debug)]
pub enum EvaluationError<T> {
NoResults,
TooManyResults,
OperatorFailed(T),
}
pub trait Operator<T> {
type Err;
fn execute(&self, stack: &mut Vec<T>) -> Result<(), Self::Err>;
}
#[derive(Clone, Copy, Debug)]
enum Element<O> {
Operator(O),
Variable(usize),
}
#[derive(Clone, Debug)]
pub struct Expression<O> {
elements: Vec<Element<O>>,
symbols: Vec<String>,
}
impl<O> Expression<O> {
pub fn evaluate<T>(
&self,
mut bindings: impl FnMut(usize) -> T,
) -> Result<T, EvaluationError<O::Err>>
where
O: Operator<T>,
{
let mut stack = Vec::new();
for element in self.elements.iter() {
match element {
Element::Variable(index) => stack.push(bindings(*index)),
Element::Operator(op) => op
.execute(&mut stack)
.map_err(EvaluationError::OperatorFailed)?,
}
}
match stack.pop() {
Some(result) if stack.is_empty() => Ok(result),
Some(_) => Err(EvaluationError::TooManyResults),
None => Err(EvaluationError::NoResults),
}
}
pub fn symbols(&self) -> &[String] {
&self.symbols
}
pub fn formatted(&self) -> Result<String, EvaluationError<O::Err>>
where
O: Operator<Formatted>,
{
self.evaluate(|index| Formatted(self.symbols[index].clone()))
.map(|formatted| formatted.0)
}
}
#[derive(Clone, Debug)]
pub struct Formatted(pub String);
impl Display for Formatted {
fn fmt(&self, f: &mut Formatter<'_>) -> std::fmt::Result {
write!(f, "{}", self.0)
}
}
impl<O> Display for Expression<O>
where
O: Operator<Formatted>,
{
fn fmt(&self, f: &mut Formatter<'_>) -> std::fmt::Result {
match self.formatted() {
Ok(result) => write!(f, "{}", result),
Err(_) => write!(f, "<malformed expression>"),
}
}
}
// Generic parts of the parsing machinery
#[derive(Clone, Copy, Debug)]
pub enum Token<'a, O> {
LBrace,
RBrace,
Operator(O),
Variable(&'a str),
Malformed(&'a str),
}
pub type Symbol<'a, O> = (&'a str, bool, Token<'a, O>);
#[derive(Debug)]
pub struct Tokens<'a, O> {
source: &'a str,
symbols: &'a [Symbol<'a, O>],
}
impl<'a, O> Tokens<'a, O> {
pub fn new(source: &'a str, symbols: &'a [Symbol<'a, O>]) -> Self {
Self { source, symbols }
}
}
impl<'a, O: Clone> Iterator for Tokens<'a, O> {
type Item = Token<'a, O>;
fn next(&mut self) -> Option<Self::Item> {
self.source = self.source.trim_start();
let symbol = self.symbols.iter().find_map(|(symbol, word, token)| {
if self.source.starts_with(symbol) {
let end = symbol.len();
if *word {
match &self.source[end..].chars().next() {
Some(c) if !c.is_whitespace() => return None,
_ => (),
}
}
Some((token, end))
} else {
None
}
});
if let Some((token, end)) = symbol {
self.source = &self.source[end..];
Some(token.clone())
} else {
match self.source.chars().next() {
Some(c) if c.is_alphabetic() => {
let end = self
.source
.char_indices()
.find_map(|(i, c)| Some(i).filter(|_| !c.is_alphanumeric()))
.unwrap_or_else(|| self.source.len());
let result = &self.source[0..end];
self.source = &self.source[end..];
Some(Token::Variable(result))
}
Some(c) => {
let end = c.len_utf8();
let result = &self.source[0..end];
self.source = &self.source[end..];
Some(Token::Malformed(result))
}
None => None,
}
}
}
}
pub trait WithPriority {
type Priority;
fn priority(&self) -> Self::Priority;
}
impl<'a, O> FromIterator<Token<'a, O>> for Result<Expression<O>, Token<'a, O>>
where
O: WithPriority,
O::Priority: Ord,
{
fn from_iter<T: IntoIterator<Item = Token<'a, O>>>(tokens: T) -> Self {
let mut token_stack = Vec::new();
let mut indices = HashMap::new();
let mut symbols = Vec::new();
let mut elements = Vec::new();
'outer: for token in tokens {
match token {
Token::Malformed(_) => return Err(token),
Token::LBrace => token_stack.push(token),
Token::RBrace => {
// Flush all operators to the matching LBrace
while let Some(token) = token_stack.pop() {
match token {
Token::LBrace => continue 'outer,
Token::Operator(op) => elements.push(Element::Operator(op)),
_ => return Err(token),
}
}
}
Token::Variable(name) => {
let index = indices.len();
let symbol = name.to_string();
let index = *indices.entry(symbol.clone()).or_insert_with(|| {
symbols.push(symbol);
index
});
elements.push(Element::Variable(index));
}
Token::Operator(ref op) => {
while let Some(token) = token_stack.pop() {
match token {
Token::Operator(pop) if op.priority() < pop.priority() => {
elements.push(Element::Operator(pop));
}
Token::Operator(pop) => {
token_stack.push(Token::Operator(pop));
break;
}
_ => {
token_stack.push(token);
break;
}
}
}
token_stack.push(token);
}
}
}
// Handle leftovers
while let Some(token) = token_stack.pop() {
match token {
Token::Operator(op) => elements.push(Element::Operator(op)),
_ => return Err(token),
}
}
Ok(Expression { elements, symbols })
}
}
// Definition of Boolean operators
#[derive(Clone, Copy, Debug, PartialEq, Eq)]
pub enum Boolean {
Or,
Xor,
And,
Not,
}
impl Display for Boolean {
fn fmt(&self, f: &mut Formatter<'_>) -> std::fmt::Result {
let s = match self {
Self::Or => "∨",
Self::And => "∧",
Self::Not => "¬",
Self::Xor => "⩛",
};
write!(f, "{}", s)
}
}
impl WithPriority for Boolean {
type Priority = u8;
fn priority(&self) -> u8 {
match self {
Self::Or => 0,
Self::Xor => 1,
Self::And => 2,
Self::Not => 3,
}
}
}
#[derive(Clone, Debug)]
pub enum BooleanError {
StackUnderflow,
}
impl Operator<bool> for Boolean {
type Err = BooleanError;
fn execute(&self, stack: &mut Vec<bool>) -> Result<(), Self::Err> {
let mut pop = || stack.pop().ok_or(BooleanError::StackUnderflow);
let result = match self {
Boolean::Or => pop()? | pop()?,
Boolean::And => pop()? & pop()?,
Boolean::Xor => pop()? ^ pop()?,
Boolean::Not => !pop()?,
};
stack.push(result);
Ok(())
}
}
impl Operator<Formatted> for Boolean {
type Err = BooleanError;
fn execute(&self, stack: &mut Vec<Formatted>) -> Result<(), Self::Err> {
let mut pop = || stack.pop().ok_or(BooleanError::StackUnderflow);
let result = match self {
Boolean::Not => format!("{}{}", Boolean::Not, pop()?),
binary_operator => {
// The stack orders the operands backwards, so to format them
// properly, we have to count with the reversed popping order
let b = pop()?;
let a = pop()?;
format!("({} {} {})", a, binary_operator, b)
}
};
stack.push(Formatted(result));
Ok(())
}
}
impl Boolean {
// It is important for the tokens to be ordered by their parsing priority (if
// some operator was a prefix of another operator, the prefix must come later)
const SYMBOLS: [Symbol<'static, Boolean>; 18] = [
("(", false, Token::LBrace),
(")", false, Token::RBrace),
("|", false, Token::Operator(Boolean::Or)),
("∨", false, Token::Operator(Boolean::Or)),
("or", true, Token::Operator(Boolean::Or)),
("OR", true, Token::Operator(Boolean::Or)),
("&", false, Token::Operator(Boolean::And)),
("∧", false, Token::Operator(Boolean::And)),
("and", true, Token::Operator(Boolean::And)),
("AND", true, Token::Operator(Boolean::And)),
("!", false, Token::Operator(Boolean::Not)),
("¬", false, Token::Operator(Boolean::Not)),
("not", true, Token::Operator(Boolean::Not)),
("NOT", true, Token::Operator(Boolean::Not)),
("^", false, Token::Operator(Boolean::Xor)),
("⩛", false, Token::Operator(Boolean::Xor)),
("xor", true, Token::Operator(Boolean::Xor)),
("XOR", true, Token::Operator(Boolean::Xor)),
];
pub fn tokenize(s: &str) -> Tokens<'_, Boolean> {
Tokens::new(s, &Self::SYMBOLS)
}
pub fn parse<'a>(s: &'a str) -> Result<Expression<Boolean>, Token<'a, Boolean>> {
Self::tokenize(s).collect()
}
}
// Finally the table printing
fn print_truth_table(s: &str) -> Result<(), std::borrow::Cow<'_, str>> {
let expression = Boolean::parse(s).map_err(|e| format!("Parsing failed at token {:?}", e))?;
let formatted = expression
.formatted()
.map_err(|_| "Malformed expression detected.")?;
let var_count = expression.symbols().len();
if var_count > 64 {
return Err("Too many variables to list.".into());
}
let column_widths = {
// Print header and compute the widths of columns
let mut widths = Vec::with_capacity(var_count);
for symbol in expression.symbols() {
print!("{} ", symbol);
widths.push(symbol.chars().count() + 2); // Include spacing
}
println!("{}", formatted);
let width = widths.iter().sum::<usize>() + formatted.chars().count();
(0..width).for_each(|_| print!("-"));
println!();
widths
};
// Choose the bit extraction order for the more traditional table ordering
let var_value = |input, index| (input >> (var_count - 1 - index)) & 1 ^ 1;
// Use counter to enumerate all bit combinations
for var_values in 0u64..(1 << var_count) {
for (var_index, width) in column_widths.iter().enumerate() {
let value = var_value(var_values, var_index);
print!("{:<width$}", value, width = width);
}
match expression.evaluate(|var_index| var_value(var_values, var_index) == 1) {
Ok(result) => println!("{}", if result { "1" } else { "0" }),
Err(e) => println!("{:?}", e),
}
}
println!();
Ok(())
}
fn main() {
loop {
let input = {
println!("Enter the expression to parse (or nothing to quit):");
let mut input = String::new();
std::io::stdin().read_line(&mut input).unwrap();
println!();
input
};
if input.trim().is_empty() {
break;
}
if let Err(e) = print_truth_table(&input) {
eprintln!("{}\n", e);
}
}
}

23
Task/Truth-table/Sidef/truth-table.sidef Normal file
View file

@ -0,0 +1,23 @@
loop {
var expr = Sys.readln("\nBoolean expression (e.g. 'a & b'): ").strip.lc
break if expr.is_empty;
var vars = expr.scan(/[[:alpha:]]+/)
if (vars.is_empty) {
say "no variables detected in your boolean expression"
next
}
var prefix = [];
var suffix = [];
vars.each { |v|
print "#{v}\t"
prefix << "[false, true].each { |#{v}|"
suffix << "}"
}
say "| #{expr}"
var body = ("say (" + vars.map{|v| v+",'\t'," }.join + " '| ', #{expr})")
eval(prefix + [body] + suffix -> join("\n"))
}

55
Task/Truth-table/Smalltalk/truth-table.st Normal file
View file

@ -0,0 +1,55 @@
[:repeat |
expr := Stdin
request:'Enter boolean expression (name variables a,b,c...):'
defaultAnswer:'a|b'.
ast := Parser parseExpression:expr inNameSpace:nil onError:repeat.
"
ensure that only boolean logic operations are inside (sandbox)
"
(ast messageSelectors asSet
conform:[:each | #( '|' '&' 'not' 'xor:' '==>' ) includes:each])
ifFalse:repeat.
] valueWithRestart.
"
extract variables from the AST as a collection
(i.e. if user entered 'a & (b | x)', we get #('a' 'b' 'x')
"
varNames := StringCollection streamContents:[:s | ast variableNodesDo:[:each | s nextPut:each name]].
"
generate code for a block (aka lambda) to evaluate it; this makes a string like:
[:a :b :x | a & (b | x) ]
"
code := '[' , ((varNames collect:[:nm | ':',nm]) asString), ' | ' , expr , ']'.
"
eval the code, to get the block
"
func := Parser evaluate:code.
'Truth table for %s:\n' printf:{expr} on:Stdout.
'===================\n' printf:{} on:Stdout.
(varNames,{' result'}) do:[:each | '|%6s' printf:{each} on:Stdout].
Stdout cr.
Stdout next:(varNames size + 1)*7 put:$-.
Stdout cr.
"
now print with all combinations
"
allCombinationsDo :=
[:remainingVars :valuesIn :func |
remainingVars isEmpty ifTrue:[
valuesIn do:[:each | '|%6s' printf:{each}on:Stdout].
'|%6s\n' printf:{ func valueWithArguments:valuesIn} on:Stdout.
] ifFalse:[
#(false true) do:[:each |
allCombinationsDo value:(remainingVars from:2)
value:(valuesIn copyWith:each)
value:func.
].
].
].
allCombinationsDo value:varNames value:#() value:func

17
Task/Truth-table/Tcl/truth-table.tcl Normal file
View file

@ -0,0 +1,17 @@
package require Tcl 8.5
puts -nonewline "Enter a boolean expression: "
flush stdout
set exp [gets stdin]
# Generate the nested loops as the body of a lambda term.
set vars [lsort -unique [regexp -inline -all {\$\w+} $exp]]
set cmd [list format [string repeat "%s\t" [llength $vars]]%s]
append cmd " {*}\[[list subst $vars]\] \[[list expr $exp]\]"
set cmd "puts \[$cmd\]"
foreach v [lreverse $vars] {
set cmd [list foreach [string range $v 1 end] {0 1} $cmd]
}
puts [join $vars \t]\tResult
apply [list {} $cmd]

304
Task/Truth-table/Visual-Basic-.NET/truth-table.vb Normal file
View file

@ -0,0 +1,304 @@
Imports System.Text
Module Module1
Structure Operator_
Public ReadOnly Symbol As Char
Public ReadOnly Precedence As Integer
Public ReadOnly Arity As Integer
Public ReadOnly Fun As Func(Of Boolean, Boolean, Boolean)
Public Sub New(symbol As Char, precedence As Integer, f As Func(Of Boolean, Boolean))
Me.New(symbol, precedence, 1, Function(l, r) f(r))
End Sub
Public Sub New(symbol As Char, precedence As Integer, f As Func(Of Boolean, Boolean, Boolean))
Me.New(symbol, precedence, 2, f)
End Sub
Public Sub New(symbol As Char, precedence As Integer, arity As Integer, fun As Func(Of Boolean, Boolean, Boolean))
Me.Symbol = symbol
Me.Precedence = precedence
Me.Arity = arity
Me.Fun = fun
End Sub
End Structure
Public Class OperatorCollection
Implements IEnumerable(Of Operator_)
ReadOnly operators As IDictionary(Of Char, Operator_)
Public Sub New(operators As IDictionary(Of Char, Operator_))
Me.operators = operators
End Sub
Public Sub Add(symbol As Char, precedence As Integer, fun As Func(Of Boolean, Boolean))
operators.Add(symbol, New Operator_(symbol, precedence, fun))
End Sub
Public Sub Add(symbol As Char, precedence As Integer, fun As Func(Of Boolean, Boolean, Boolean))
operators.Add(symbol, New Operator_(symbol, precedence, fun))
End Sub
Public Sub Remove(symbol As Char)
operators.Remove(symbol)
End Sub
Public Function GetEnumerator() As IEnumerator(Of Operator_) Implements IEnumerable(Of Operator_).GetEnumerator
Return operators.Values.GetEnumerator
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
End Class
Structure BitSet
Private ReadOnly bits As Integer
Public Sub New(bits As Integer)
Me.bits = bits
End Sub
Public Shared Operator +(bs As BitSet, v As Integer) As BitSet
Return New BitSet(bs.bits + v)
End Operator
Default Public ReadOnly Property Test(index As Integer) As Boolean
Get
Return (bits And (1 << index)) <> 0
End Get
End Property
End Structure
Public Class TruthTable
Enum TokenType
Unknown
WhiteSpace
Constant
Operand
Operator_
LeftParenthesis
RightParenthesis
End Enum
ReadOnly falseConstant As Char
ReadOnly trueConstant As Char
ReadOnly operatorDict As New Dictionary(Of Char, Operator_)
Public ReadOnly Operators As OperatorCollection
Sub New(falseConstant As Char, trueConstant As Char)
Me.falseConstant = falseConstant
Me.trueConstant = trueConstant
Operators = New OperatorCollection(operatorDict)
End Sub
Private Function TypeOfToken(c As Char) As TokenType
If Char.IsWhiteSpace(c) Then
Return TokenType.WhiteSpace
End If
If c = "("c Then
Return TokenType.LeftParenthesis
End If
If c = ")"c Then
Return TokenType.RightParenthesis
End If
If c = trueConstant OrElse c = falseConstant Then
Return TokenType.Constant
End If
If operatorDict.ContainsKey(c) Then
Return TokenType.Operator_
End If
If Char.IsLetter(c) Then
Return TokenType.Operand
End If
Return TokenType.Unknown
End Function
Private Function Precedence(op As Char) As Integer
Dim o As New Operator_
If operatorDict.TryGetValue(op, o) Then
Return o.Precedence
Else
Return Integer.MinValue
End If
End Function
Public Function ConvertToPostfix(infix As String) As String
Dim stack As New Stack(Of Char)
Dim postfix As New StringBuilder()
For Each c In infix
Dim type = TypeOfToken(c)
Select Case type
Case TokenType.WhiteSpace
Continue For
Case TokenType.Constant, TokenType.Operand
postfix.Append(c)
Case TokenType.Operator_
Dim precedence_ = Precedence(c)
While stack.Count > 0 AndAlso Precedence(stack.Peek()) > precedence_
postfix.Append(stack.Pop())
End While
stack.Push(c)
Case TokenType.LeftParenthesis
stack.Push(c)
Case TokenType.RightParenthesis
Dim top As Char
While stack.Count > 0
top = stack.Pop()
If top = "("c Then
Exit While
Else
postfix.Append(top)
End If
End While
If top <> "("c Then
Throw New ArgumentException("No matching left parenthesis.")
End If
Case Else
Throw New ArgumentException("Invalid character: " + c)
End Select
Next
While stack.Count > 0
Dim top = stack.Pop()
If top = "("c Then
Throw New ArgumentException("No matching right parenthesis.")
End If
postfix.Append(top)
End While
Return postfix.ToString
End Function
Private Function Evaluate(expression As Stack(Of Char), values As BitSet, parameters As IDictionary(Of Char, Integer)) As Boolean
If expression.Count = 0 Then
Throw New ArgumentException("Invalid expression.")
End If
Dim c = expression.Pop()
Dim type = TypeOfToken(c)
While type = TokenType.WhiteSpace
c = expression.Pop()
type = TypeOfToken(c)
End While
Select Case type
Case TokenType.Constant
Return c = trueConstant
Case TokenType.Operand
Return values(parameters(c))
Case TokenType.Operator_
Dim right = Evaluate(expression, values, parameters)
Dim op = operatorDict(c)
If op.Arity = 1 Then
Return op.Fun(right, right)
End If
Dim left = Evaluate(expression, values, parameters)
Return op.Fun(left, right)
Case Else
Throw New ArgumentException("Invalid character: " + c)
End Select
Return False
End Function
Public Iterator Function GetTruthTable(expression As String, Optional isPostfix As Boolean = False) As IEnumerable(Of String)
If String.IsNullOrWhiteSpace(expression) Then
Throw New ArgumentException("Invalid expression.")
End If
REM Maps parameters to an index in BitSet
REM Makes sure they appear in the truth table in the order they first appear in the expression
Dim parameters = expression _
.Where(Function(c) TypeOfToken(c) = TokenType.Operand) _
.Distinct() _
.Reverse() _
.Select(Function(c, i) Tuple.Create(c, i)) _
.ToDictionary(Function(p) p.Item1, Function(p) p.Item2)
Dim count = parameters.Count
If count > 32 Then
Throw New ArgumentException("Cannot have more than 32 parameters.")
End If
Dim header = If(count = 0, expression, String.Join(" ", parameters.OrderByDescending(Function(p) p.Value).Select(Function(p) p.Key)) & " " & expression)
If Not isPostfix Then
expression = ConvertToPostfix(expression)
End If
Dim values As BitSet
Dim stack As New Stack(Of Char)(expression.Length)
Dim loopy = 1 << count
While loopy > 0
For Each token In expression
stack.Push(token)
Next
Dim result = Evaluate(stack, values, parameters)
If Not IsNothing(header) Then
If stack.Count > 0 Then
Throw New ArgumentException("Invalid expression.")
End If
Yield header
header = Nothing
End If
Dim line = If(count = 0, "", " ") + If(result, trueConstant, falseConstant)
line = String.Join(" ", Enumerable.Range(0, count).Select(Function(i) If(values(count - i - 1), trueConstant, falseConstant))) + line
Yield line
values += 1
''''''''''''''''''''''''''''
loopy -= 1
End While
End Function
Public Sub PrintTruthTable(expression As String, Optional isPostfix As Boolean = False)
Try
For Each line In GetTruthTable(expression, isPostfix)
Console.WriteLine(line)
Next
Catch ex As ArgumentException
Console.WriteLine(expression + " " + ex.Message)
End Try
End Sub
End Class
Sub Main()
Dim tt As New TruthTable("F"c, "T"c)
tt.Operators.Add("!"c, 6, Function(r) Not r)
tt.Operators.Add("&"c, 5, Function(l, r) l And r)
tt.Operators.Add("^"c, 4, Function(l, r) l Xor r)
tt.Operators.Add("|"c, 3, Function(l, r) l Or r)
REM add a crazy operator
Dim rng As New Random
tt.Operators.Add("?"c, 6, Function(r) rng.NextDouble() < 0.5)
Dim expressions() = {
"!!!T",
"?T",
"F & x | T",
"F & (x | T",
"F & x | T)",
"a ! (a & a)",
"a | (a * a)",
"a ^ T & (b & !c)"
}
For Each expression In expressions
tt.PrintTruthTable(expression)
Console.WriteLine()
Next
REM Define a different language
tt = New TruthTable("0"c, "1"c)
tt.Operators.Add("-"c, 6, Function(r) Not r)
tt.Operators.Add("^"c, 5, Function(l, r) l And r)
tt.Operators.Add("v"c, 3, Function(l, r) l Or r)
tt.Operators.Add(">"c, 2, Function(l, r) Not l Or r)
tt.Operators.Add("="c, 1, Function(l, r) l = r)
expressions = {
"-X v 0 = X ^ 1",
"(H > M) ^ (S > H) > (S > M)"
}
For Each expression In expressions
tt.PrintTruthTable(expression)
Console.WriteLine()
Next
End Sub
End Module

85
Task/Truth-table/Wren/truth-table.wren Normal file
View file

@ -0,0 +1,85 @@
import "/dynamic" for Struct
import "/ioutil" for Input
import "/seq" for Stack
import "/str" for Str
var Variable = Struct.create("Variable", ["name", "value"])
// use integer constants as bools don't support bitwise operators
var FALSE = 0
var TRUE = 1
var expr = ""
var variables = []
var isOperator = Fn.new { |op| "&|!^".contains(op) }
var isVariable = Fn.new { |s| variables.map { |v| v.name }.contains(s) }
var evalExpression = Fn.new {
var stack = Stack.new()
for (e in expr) {
var v
if (e == "T") {
v = TRUE
} else if (e == "F") {
v = FALSE
} else if (isVariable.call(e)) {
var vs = variables.where { |v| v.name == e }.toList
if (vs.count != 1) Fiber.abort("Can only be one variable with name %(e).")
v = vs[0].value
} else if (e == "&") {
v = stack.pop() & stack.pop()
} else if (e == "|") {
v = stack.pop() | stack.pop()
} else if (e == "!") {
v = (stack.pop() == TRUE) ? FALSE : TRUE
} else if (e == "^") {
v = stack.pop() ^ stack.pop()
} else {
Fiber.abort("Non-conformant character %(e) in expression")
}
stack.push(v)
}
if (stack.count != 1) Fiber.abort("Something went wrong!")
return stack.peek()
}
var setVariables // recursive
setVariables = Fn.new { |pos|
var vc = variables.count
if (pos > vc) Fiber.abort("Argument cannot exceed %(vc).")
if (pos == vc) {
var vs = variables.map { |v| (v.value == TRUE) ? "T" : "F" }.toList
var es = (evalExpression.call() == TRUE) ? "T" : "F"
System.print("%(vs.join(" ")) %(es)")
return
}
variables[pos].value = FALSE
setVariables.call(pos + 1)
variables[pos].value = TRUE
setVariables.call(pos + 1)
}
System.print("Accepts single-character variables (except for 'T' and 'F',")
System.print("which specify explicit true or false values), postfix, with")
System.print("&|!^ for and, or, not, xor, respectively; optionally")
System.print("seperated by spaces or tabs. Just enter nothing to quit.")
while (true) {
expr = Input.text("\nBoolean expression: ")
if (expr == "") return
expr = Str.upper(expr).replace(" ", "").replace("\t", "")
variables.clear()
for (e in expr) {
if (!isOperator.call(e) && !"TF".contains(e) && !isVariable.call(e)) {
variables.add(Variable.new(e, FALSE))
}
}
if (variables.isEmpty) return
var vs = variables.map { |v| v.name }.join(" ")
System.print("\n%(vs) %(expr)")
var h = vs.count + expr.count + 2
System.print("=" * h)
setVariables.call(0)
}

218
Task/Truth-table/XBasic/truth-table.basic Normal file
View file

@ -0,0 +1,218 @@
PROGRAM "truthtables"
VERSION "0.001"
$$MaxTop = 80
TYPE VARIABLE
STRING*1 .name
SBYTE .value
END TYPE
TYPE STACKOFBOOL
SSHORT .top
SBYTE .elements[$$MaxTop]
END TYPE
DECLARE FUNCTION Entry()
INTERNAL FUNCTION IsOperator(c$)
INTERNAL FUNCTION VariableIndex(c$)
INTERNAL FUNCTION SetVariables(pos%)
INTERNAL FUNCTION ProcessExpression()
INTERNAL FUNCTION EvaluateExpression()
' Stack manipulation functions
INTERNAL FUNCTION IsFull(STACKOFBOOL @s)
INTERNAL FUNCTION IsEmpty(STACKOFBOOL @s)
INTERNAL FUNCTION Peek(STACKOFBOOL @s)
INTERNAL FUNCTION Push(STACKOFBOOL @s, val@)
INTERNAL FUNCTION Pop(STACKOFBOOL @s)
INTERNAL FUNCTION MakeEmpty(STACKOFBOOL @s)
INTERNAL FUNCTION ElementsCount(STACKOFBOOL @s)
FUNCTION Entry()
SHARED VARIABLE variables[]
SHARED variablesLength%
SHARED expression$
DIM variables[23]
PRINT "Accepts single-character variables (except for 'T' and 'F',"
PRINT "which specify explicit true or false values), postfix, with"
PRINT "&|!^ for and, or, not, xor, respectively; optionally"
PRINT "seperated by space. Just enter nothing to quit."
DO
PRINT
expression$ = INLINE$("Boolean expression: ")
ProcessExpression()
IF LEN(expression$) = 0 THEN
EXIT DO
END IF
variablesLength% = 0
FOR i% = 0 TO LEN(expression$) - 1
e$ = CHR$(expression${i%})
IF (!IsOperator(e$)) && (e$ <> "T") && (e$ <> "F") && (VariableIndex(e$) = -1) THEN
variables[variablesLength%].name = LEFT$(e$, 1)
variables[variablesLength%].value = $$FALSE
INC variablesLength%
END IF
NEXT i%
PRINT
IF variablesLength% = 0 THEN
PRINT "No variables were entered."
ELSE
FOR i% = 0 TO variablesLength% - 1
PRINT variables[i%].name; " ";
NEXT i%
PRINT expression$
PRINT CHR$(ASC("="), variablesLength% * 3 + LEN(expression$))
SetVariables(0)
END IF
LOOP
END FUNCTION
' Removes space and converts to upper case
FUNCTION ProcessExpression()
SHARED expression$
'
exprTmp$ = ""
FOR i% = 0 TO LEN(expression$) - 1
IF CHR$(expression${i%}) <> " " THEN
exprTmp$ = exprTmp$ + UCASE$(CHR$(expression${i%}))
END IF
NEXT i%
expression$ = exprTmp$
END FUNCTION
FUNCTION IsOperator(c$)
RETURN (c$ = "&") || (c$ = "|") || (c$ = "!") || (c$ = "^")
END FUNCTION
FUNCTION VariableIndex(c$)
SHARED VARIABLE variables[]
SHARED variablesLength%
'
FOR i% = 0 TO variablesLength% - 1
IF variables[i%].name = c$ THEN
RETURN i%
END IF
NEXT i%
RETURN -1
END FUNCTION
FUNCTION SetVariables(pos%)
SHARED VARIABLE variables[]
SHARED variablesLength%
'
SELECT CASE TRUE
CASE pos% > variablesLength%:
PRINT
PRINT "Argument to SetVariables cannot be greater than the number of variables."
QUIT(1)
CASE pos% = variablesLength%:
FOR i% = 0 TO variablesLength% - 1
IF variables[i%].value THEN
PRINT "T ";
ELSE
PRINT "F ";
END IF
NEXT i%
IF EvaluateExpression() THEN
PRINT "T"
ELSE
PRINT "F"
END IF
CASE ELSE:
variables[pos%].value = $$FALSE
SetVariables(pos% + 1)
variables[pos%].value = $$TRUE
SetVariables(pos% + 1)
END SELECT
END FUNCTION
FUNCTION EvaluateExpression()
SHARED VARIABLE variables[]
SHARED expression$
STACKOFBOOL s
'
MakeEmpty(@s)
FOR i% = 0 TO LEN(expression$) - 1
e$ = CHR$(expression${i%})
vi% = VariableIndex(e$)
SELECT CASE TRUE
CASE e$ = "T":
Push(@s, $$TRUE)
CASE e$ = "F":
Push(@s, $$FALSE)
CASE vi% >= 0:
Push(@s, variables[vi%].value)
CASE ELSE:
SELECT CASE e$
CASE "&":
Push(@s, Pop(@s) & Pop(@s))
CASE "|":
Push(@s, Pop(@s) | Pop(@s))
CASE "!":
Push(@s, !Pop(@s))
CASE "^":
Push(@s, Pop(@s) ^ Pop(@s))
CASE ELSE:
PRINT
PRINT "Non-conformant character "; e$; " in expression.";
QUIT(1)
END SELECT
END SELECT
NEXT i%
IF ElementsCount(@s) <> 1 THEN
PRINT
PRINT "Stack should contain exactly one element."
QUIT(1)
END IF
RETURN Peek(@s)
END FUNCTION
FUNCTION IsFull(STACKOFBOOL s)
RETURN s.top = $$MaxTop
END FUNCTION
FUNCTION IsEmpty(STACKOFBOOL s)
RETURN s.top = -1
END FUNCTION
FUNCTION Peek(STACKOFBOOL s)
IF !IsEmpty(@s) THEN
RETURN s.elements[s.top]
ELSE
PRINT "Stack is empty."
QUIT(1)
END IF
END FUNCTION
FUNCTION Push(STACKOFBOOL s, val@)
IF !IsFull(@s) THEN
INC s.top
s.elements[s.top] = val@
ELSE
PRINT "Stack is full."
QUIT(1)
END IF
END FUNCTION
FUNCTION Pop(STACKOFBOOL s)
IF !IsEmpty(@s) THEN
res@ = s.elements[s.top]
DEC s.top
RETURN res@
ELSE
PRINT
PRINT "Stack is empty."
QUIT(1)
END IF
END FUNCTION
FUNCTION MakeEmpty(STACKOFBOOL s)
s.top = -1
END FUNCTION
FUNCTION ElementsCount(STACKOFBOOL s)
RETURN s.top + 1
END FUNCTION
END PROGRAM