Ternary logic

From Rosetta Code
Revision as of 06:27, 26 August 2011 by rosettacode>NevilleDNZ (→‎[[Ternary_logic#ALGOL 68]]: Foundation page)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Ternary logic is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
Task
Ternary logic
You are encouraged to solve this task according to the task description, using any language you may know.
This page uses content from Wikipedia. The original article was at Ternary logic. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance)

In logic, a three-valued logic (also trivalent, ternary, or trinary logic, sometimes abbreviated 3VL) is any of several many-valued logic systems in which there are three truth values indicating true, false and some indeterminate third value. This is contrasted with the more commonly known bivalent logics (such as classical sentential or boolean logic) which provide only for true and false. Conceptual form and basic ideas were initially created by Łukasiewicz, Lewis and Sulski. These were then re-formulated by Grigore Moisil in an axiomatic algebraic form, and also extended to n-valued logics in 1945.

Task:

  • Define a new type that emulates Ternary logic by storing data trits.
  • Given all the binary operators of the original programming language, reimplement these operators for the new Ternary_logic type trit.
  • Generate a sampling of results using trit variables.
  • Kudos for actually thinking up a test case algorithm where ternary logic is intrinsically useful, optimises the test case algorithm and is preferable to binary logic.

ALGOL 68

Works with: ALGOL 68 version Revision 1 - no extensions to language used.
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.

File: Ternary_logic.a68 <lang algol68># -*- coding: utf-8 -*- #

MODE TRIT = STRUCT(BITS trit); INT trit width = 1, trit base = 3; FORMAT trit fmt = $c("⌊","⌈","?" #|"~"#)$;

  1. These values treated are as per "Balanced ternary" #
  2. eg true=1, maybe=0, false=-1 #

TRIT true =INITTRIT 4r1 #⌈#, maybe=INITTRIT 4r0 #?#,

    false=INITTRIT 4r2 #⌊#;

TRIT flip=true, flop=false, flap=maybe;

OP REPR = (TRIT t)STRING:

 IF   t = false THEN "⌊"
 ELIF t = maybe THEN "?"
 ELIF t = true  THEN "⌈"
 ELSE raise value error(("invalid TRIT value",INITINT t));~
 FI;
  1. Define some OPerators for coercing MODES #

OP INITTRIT = (BOOL in)TRIT:

 (in|true|false);

OP B = (TRIT in)BOOL:

 (in=true|TRUE|:in=false|FALSE|
   raise value error(("invalid TRIT to BOOL coercion: """, REPR in,""""));~
 );
  1. These values treated are as per "Balanced ternary" #
  2. n.b true=1, maybe=0, false=-1 #
  3. Warning: BOOL ABS FALSE (0) is not the same as TRIT ABS false (-1) #

OP INITINT = (TRIT t)INT:

 IF   t=true  THEN 1
 ELIF t=maybe THEN 0
 ELIF t=false THEN -1
 ELSE raise value error(("invalid TRIT value",REPR t));~
 FI;

OP INITTRIT = (INT in)TRIT: (

 TRIT out;
 trit OF out:= trit OF
   IF   in= 1 THEN true
   ELIF in= 0 THEN maybe
   ELIF in=-1 THEN false
   ELSE raise value error(("invalid TRIT value",in));~
   FI;
 out

);

OP INITTRIT = (BITS b)TRIT:

 (TRIT out; trit OF out:=b; out);
  1. Define the OPerators for the TRIT MODE #
  1. These can be optimised by peekng at the binary value #
  2. These operators are as per "Balanced ternary" #
  3. Warning: "both" is ignored as it isn't Ternary #

OP LT = (TRIT a,b)BOOL: a EQ false AND b NE false OR a EQ maybe AND b EQ true,

  LE = (TRIT a,b)BOOL: a EQ b OR a LT b,
  EQ = (TRIT a,b)BOOL: trit OF a = trit OF b,
  NE = (TRIT a,b)BOOL: NOT (a EQ b),
  GE = (TRIT a,b)BOOL: NOT (a LT b),
  GT = (TRIT a,b)BOOL: NOT (a LE b);
  1. A solo, unique and rather confusing CMP OPerator #

PRIO CMP = 5; OP CMP = (TRIT a,b)TRIT:

 IF a < b THEN false
 ELIF a = b THEN maybe
 ELIF a > b THEN true
 FI;
  1. ASCII OPerators #

OP < = (TRIT a,b)BOOL: a LT b,

  <= = (TRIT a,b)BOOL: a LE b,
   = = (TRIT a,b)BOOL: a EQ b,
  /= = (TRIT a,b)BOOL: a NE b,
  >= = (TRIT a,b)BOOL: a GE b,
  >  = (TRIT a,b)BOOL: a GT b;
  1. Non ASCII OPerators

OP ≤ = (TRIT a,b)BOOL: a LE b,

  ≠ = (TRIT a,b)BOOL: a NE b,
  ≥ = (TRIT a,b)BOOL: a GE b;

OP - = (TRIT t)TRIT:

 IF   t=maybe THEN maybe
 ELIF t=true THEN false
 ELIF t=false THEN true
 ELSE raise value error(("invalid TRIT value",REPR t)); ~
 FI;
  1. Warning: This routine ASSIGNS "out" AND returns "carry" #

OP +:= = (REF TRIT out, TRIT arg)TRIT:

 IF   out = maybe THEN out :=  arg; maybe
 ELIF arg = maybe THEN # out:= out# arg
 ELIF out =  arg THEN out := -out; arg
 ELIF out = -arg THEN out:=maybe; maybe
 ELSE raise value error((REPR out," + ",REPR arg)); ~
 FI;

OP + = (TRIT a, b)TRIT:

 (TRIT out:=a; VOID(out+:=b); out);

OP - = (TRIT a, b)TRIT:

 a + -b;

OP * = (TRIT a, b)TRIT:

 IF   a = maybe OR b = maybe THEN maybe
 ELIF a = b THEN true
 ELSE false
 FI;

OP ODD = (TRIT t)BOOL:

 t /= maybe;

COMMENT

 Kleene logic truth tables:

END COMMENT

OP AND = (TRIT a,b)TRIT: (

 [,]TRIT(
   # ∧      maybe, true,  false,  #
   #maybe# (maybe, maybe, false),
   #true#  (maybe, true,  false),
   #false# (false, false, false)
 )[@0,@0][ABS trit OF a, ABS trit OF b]

);

OP OR = (TRIT a,b)TRIT: (

 [,]TRIT(
   # ∨      maybe, true, false,  #
   #maybe# (maybe, true, maybe),
   #true#  (true,  true, true),
   #false# (maybe, true, false)
 )[@0,@0][ABS trit OF a, ABS trit OF b]

);

PRIO IMPLIES = 1; # 1.9 # OP IMPLIES = (TRIT a,b)TRIT: (

 [,]TRIT(
   # ⊃      maybe, true, false, #
   #maybe# (maybe, true, maybe),
   #true#  (maybe, true, false),
   #false# (true,  true, true)
 )[@0,@0][ABS trit OF a, ABS trit OF b]

);

PRIO EQV = 1; # 1.8 # OP EQV = (TRIT a,b)TRIT: (

 [,]TRIT(
   # ≡      maybe, true,  false, #
   #maybe# (maybe, maybe, maybe),
   #true#  (maybe, true,  false),
   #false# (maybe, false, true)
 )[@0,@0][ABS trit OF a, ABS trit OF b]

);

  1. Non ASCII OPerators

OP ¬ = (TRIT a)TRIT: NOT b,

  ∨ = (TRIT a,b)TRIT: a OR b,
  ∧ = (TRIT a,b)TRIT: a AND b,
  & = (TRIT a,b)TRIT: a AND b,
  ⊃ = (TRIT a,b)TRIT: a IMPLIES b,
  ≡ = (TRIT a,b)TRIT: a EQV b;
  1. </lang>File: test_Ternary_logic.a68

<lang algol68>#!/usr/local/bin/a68g --script #

  1. -*- coding: utf-8 -*- #

PR READ "prelude/general.a68" PR PR READ "Ternary_logic.a68" PR

[]TRIT trits = (false, maybe, true);

FORMAT col fmt = $" "g" "$; FORMAT row fmt = $l3(f(col fmt)"|")f(col fmt)$; FORMAT row sep fmt = $l3("---+")"---"l$;

PROC row sep = VOID:

 printf(row sep fmt);

PROC title = (UTF op)VOID:(

 print(("Operator: ",op));
 printf((row fmt," ",REPR false, REPR maybe, REPR true));
 row sep

);


PROC print bool op table = (STRING op name, PROC(TRIT,TRIT)BOOL op)VOID: (

 title(op name);
 FOR i FROM LWB trits TO UPB trits DO
   TRIT ti = trits[i];
   printf((col fmt, REPR ti));
   FOR j FROM LWB trits TO UPB trits DO
     TRIT tj = trits[j];
     printf(($"|"$, col fmt, op(ti,tj)))
   OD;
   row sep
 OD;
 print(new line)

);

PROC print trit op table = (STRING op name, PROC(TRIT,TRIT)TRIT op)VOID: (

 title(op name);
 FOR i FROM LWB trits TO UPB trits DO
   TRIT ti = trits[i];
   printf((col fmt, REPR ti));
   FOR j FROM LWB trits TO UPB trits DO
     TRIT tj = trits[j];
     printf(($"|"$, col fmt, REPR op(ti,tj)))
   OD;
   row sep
 OD;
 print(new line)

);

printf((

 $"Comparitive table of coercions:"l$,
 $"  TRIT BOOL         INT"l$

));

FOR it FROM LWB trits TO UPB trits DO

 TRIT t = trits[it];
 IF t = maybe THEN
   printf(($"  "g"  "$, REPR t, " ", INITINT t, $l$))
 ELSE
   printf(($"  "g"  "$, REPR t, B    t, INITINT t, $l$))
 FI

OD;

printf((

 $l"Specific test of the IMPLIES operator:"l$,
 $"  "g" implies "g" is "b("not ","")"a contradiction!"l$,
   B false,    B false,    B(false IMPLIES false),
   B false,    B true,     B(false IMPLIES true),
   B false,    REPR maybe, B(false IMPLIES maybe),
   B true,     B false,    B(true  IMPLIES false),
   B true,     B true,     B(true  IMPLIES true),
   REPR maybe, Btrue,      B(maybe IMPLIES true),
 $"  "g" implies "g" is "g" a contradiction!"l$,
   B true,     REPR maybe, REPR (true  IMPLIES maybe),
   REPR maybe, B false,    REPR (maybe IMPLIES false),
   REPR maybe, REPR maybe, REPR (maybe IMPLIES maybe),
 $l$

));

printf($l"Kleene logic truth table samples:"l$);

print trit op table("CMP", (TRIT a,b)TRIT: a CMP b); print trit op table("EQV", (TRIT a,b)TRIT: a EQV b); print trit op table("IMPLIES", (TRIT a,b)TRIT: a IMPLIES b); print trit op table("AND", (TRIT a,b)TRIT: a AND b); print trit op table("OR", (TRIT a,b)TRIT: a OR b) CO; print trit op table("+", (TRIT a,b)TRIT: a + b); print trit op table("-", (TRIT a,b)TRIT: a - b); print trit op table("*", (TRIT a,b)TRIT: a * b); print bool op table("EQ", (TRIT a,b)BOOL: a EQ b); print bool op table("<=", (TRIT a,b)BOOL: a <= b) END CO</lang> Output:

Comparitive table of coercions:
  TRIT BOOL         INT
  ⌊    F             -1  
  ?                  +0  
  ⌈    T             +1  

Specific test of the IMPLIES operator:
  F implies F is not a contradiction!
  F implies T is not a contradiction!
  F implies ? is not a contradiction!
  T implies F is a contradiction!
  T implies T is not a contradiction!
  ? implies T is not a contradiction!
  T implies ? is ? a contradiction!
  ? implies F is ? a contradiction!
  ? implies ? is ? a contradiction!


Kleene logic truth table samples:
Operator: CMP
   | ⌊ | ? | ⌈ 
---+---+---+---
 ⌊ | ? | ⌊ | ⌊ 
---+---+---+---
 ? | ⌈ | ? | ⌊ 
---+---+---+---
 ⌈ | ⌈ | ⌈ | ? 
---+---+---+---

Operator: EQV
   | ⌊ | ? | ⌈ 
---+---+---+---
 ⌊ | ⌈ | ? | ⌊ 
---+---+---+---
 ? | ? | ? | ? 
---+---+---+---
 ⌈ | ⌊ | ? | ⌈ 
---+---+---+---

Operator: IMPLIES
   | ⌊ | ? | ⌈ 
---+---+---+---
 ⌊ | ⌈ | ⌈ | ⌈ 
---+---+---+---
 ? | ? | ? | ⌈ 
---+---+---+---
 ⌈ | ⌊ | ? | ⌈ 
---+---+---+---

Operator: AND
   | ⌊ | ? | ⌈ 
---+---+---+---
 ⌊ | ⌊ | ⌊ | ⌊ 
---+---+---+---
 ? | ⌊ | ? | ? 
---+---+---+---
 ⌈ | ⌊ | ? | ⌈ 
---+---+---+---

Operator: OR
   | ⌊ | ? | ⌈ 
---+---+---+---
 ⌊ | ⌊ | ? | ⌈ 
---+---+---+---
 ? | ? | ? | ⌈ 
---+---+---+---
 ⌈ | ⌈ | ⌈ | ⌈ 
---+---+---+---