Anonymous user
Truth table: Difference between revisions
→{{header|REXX}}: added/changed comments and whitespace, changed some variable names.
(→{{header|REXX}}: added/changed comments and whitespace, changed some variable names.) |
|||
Line 2,685:
<br>through the 26 possible propositional constants (which makes a deeply nested DO construct, if nothing else, it looks pretty).
<br>I later added support for all 16 boolean functions --- REXX natively supports three infix operators:
::* '''&''' (and)
::* '''|''' (or)
::* '''&&''' (xor)
and one prefix operator:
::* '''¬''' (not or negation).
Some REXX
::* '''\''' (backslash)
::* '''/''' (forward slash)
::* '''~''' (
::* '''^''' (
Also included is support for two boolean values: '''TRUE''' and '''FALSE''' which are part of boolean expressions.
<lang rexx>♀/*REXX program displays a truth table
/*
/*
/*─────────────── All propositional constants are case
parse arg
if
exit
call truthTable "G ^ H ; XOR" /*
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
/* ↓↓↓ no way, Jose. ↓↓↓ */ /* [↓] shows a 32,768 line truth table*/
call truthTable "A^ (B^ (C^ (D^ (E^ (F^ (G^ (H^ (I^ (J^ (L^ (
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. */
if pos(_,$u) == 0 then
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,
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
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 __=='""' then do; j= j+1; iterate; end
quote=0; iterate
if __=="''" then do; j= j+1; iterate; end
apost=0; iterate
if _== ' ' then iterate
if _== '(' then do; Lp= Lp+1; iterate; end
if Lp\==0 then do; if _==')' then Lp= Lp-1;
if datatype(_, 'U') then return j - (at<0)
if at<0 then return j + 1 /*is _ uppercase ? */
/*──────────────────────────────────────────────────────────────────────────────────────*/
changeFunc: procedure; parse arg z, fC, newF ; funcPos= 0
funcPos= pos(fC, z, funcPos + 1); if funcPos==0 then return z
z= changestr(fC, z, ",'"newF"',") /*arg 3 ≡ ",'" || newF || "-'," */
end
/*──────────────────────────────────────────────────────────────────────────────────────*/
bool: procedure; arg a,?,b
/*0*/
/*1*/ when
/*2*/ when ?
/*3*/ when ? ==
/*4*/ when ? == 'NBIMPA'
/*5*/ when ? == 'BOOLA'
/*6*/ when ?
/*7*/ when ?
/*8*/ when ?
/*9*/ when ? == 'XNOR'
/*a*/ when ? ==
/*b*/ when ? == 'BIMPA'
/*c*/ when ? == 'NOTA'
/*d*/ when ? ==
/*e*/ when ?
/*f*/ when
end /*select*/ /*
Some older REXXes don't have a '''changestr''' BIF, so one is included here ──► [[CHANGESTR.REX]].
{{out|output|text= when using the default inputs:}}
(Output is shown at three-quarter size.)
<pre style="font-size:75%;height:115ex">
G H G ^ H ; XOR
───── ───── ───────────
Line 2,935 ⟶ 2,944:
true false ────► true
true true ────► false
I J i | j ; OR
Line 2,942 ⟶ 2,952:
true false ────► true
true true ────► true
G H G nxor H ; NXOR
Line 2,949 ⟶ 2,960:
true false ────► false
true true ────► true
K T k ! t ; NOR
Line 2,956 ⟶ 2,968:
true false ────► false
true true ────► false
P Q p & q ; AND
Line 2,963 ⟶ 2,976:
true false ────► false
true true ────► true
E F e ¡ f ; NAND
Line 2,971 ⟶ 2,985:
true true ────► false
S T U S | (T ^ U)
───── ───── ───── ───────────
false false false ────► false
false false true ────► true
Line 2,981 ⟶ 2,996:
true true false ────► true
true true true ────► true
P Q R (p=>q) v (q=>r)
Line 2,992 ⟶ 3,008:
true true false ────► true
true true true ────► true
A B C D A ^ (B ^ (C ^ D))
|