Path: ...!news.misty.com!weretis.net!feeder9.news.weretis.net!news.nk.ca!rocksolid2!i2pn2.org!.POSTED!not-for-mail
From: melahi_ahmed@yahoo.fr (ahmed)
Newsgroups: comp.lang.forth
Subject: Re: Expert systems in forth
Date: Mon, 6 Jan 2025 00:56:37 +0000
Organization: novaBBS
Message-ID: <122d374667b564e20f642417ea857470@www.novabbs.com>
References: <069d1724f6056b4c36d9e1ffaa3d606d@www.novabbs.com> <2025Jan5.094909@mips.complang.tuwien.ac.at> <ac7f9bcea25de21c96d8addd6625e803@www.novabbs.com> <2025Jan5.160913@mips.complang.tuwien.ac.at> <nnd$28b6bf50$1efdeaad@10290eb862f73416> <79e599a35af4f1625fafa97012be8f04@www.novabbs.com>
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8; format=flowed
Content-Transfer-Encoding: 8bit
Injection-Info: i2pn2.org;
	logging-data="2212965"; mail-complaints-to="usenet@i2pn2.org";
	posting-account="t+/9LUKLIiUqIe6reyFE7me/EcA/Gr17dRXgwnADesE";
User-Agent: Rocksolid Light
X-Spam-Checker-Version: SpamAssassin 4.0.0
X-Rslight-Posting-User: 5f6b2e70af503e44dad56966aa15d35bdef29623
X-Rslight-Site: $2y$10$LZq1n1HZy74MtoaCR1dEveioa3KJ5fuKCQi1fzowG9Y.NvvV1EEzC
Bytes: 12451
Lines: 486

Here, I used ternary logic.

I defined these words:

\ 3-valued logic
254 value T \ true
127 value U \ unknown
0   value F \ false

\ lv : logic value : T, U or F
: not 0= ;
: not3 ( lv -- lv) T swap - ;
: and3 ( lv lv -- lv )  min ;
: or3 ( lv lv -- lv ) max ;
: imply3 ( lv lv -- lv)
    2dup
    T = swap T = or if 2drop T exit then
    F = swap F = or if       F exit then
    U
;

and used them.

The new version of expert_systems.fs is hereafter:

--------------- The code begins here-------------------


 \ expert system inference engin
\ forward and backward chainings

\ for iForth, vfxForth
\ false [if]
  : place  over >r rot over 1+ r> move c! ;
  : +place 2dup c@ dup >r + over c! r> 1+ + swap move ;
  : 0>= dup 0> swap 0= or ;
\ [then]


\ 3-valued logic
254 value T \ true
127 value U \ unknown
0   value F \ false

\ lv : logic value : T, U or F
: not 0= ;
: not3 ( lv -- lv) T swap - ;
: and3 ( lv lv -- lv )  min ;
: or3 ( lv lv -- lv ) max ;
: imply3 ( lv lv -- lv)
    2dup
    T = swap T = or if 2drop T exit then
    F = swap F = or if       F exit then
    U
;

\
100 constant max_num_facts
100 constant max_num_rules
255 constant rules_text_max_length

5  constant num_passes

create facts_list max_num_facts cells allot
create rules_base max_num_rules cells allot
create rules_text max_num_rules rules_text_max_length * allot

variable num_rules 0 num_rules !
variable num_facts 0 num_facts !

: >facts_list 	' 16 + facts_list num_facts @ cells + ! 1 num_facts +! ;

: current_rule_position
    rules_text num_rules @
    rules_text_max_length * +
    rules_base num_rules @ cells +
;

: current_rule_text_position   current_rule_position drop ;
: current_rule_base_position   current_rule_position nip ;

: >rule_base                   current_rule_position ! ;
: >rule_text     ( a n -- )    current_rule_text_position place ;
: >rules                       >rule_text >rule_base 1 num_rules +! ;

: .rule
    dup 0>= over num_rules @ < and if
      dup cr ." Rule n°:" . ." :    "
      cells rules_base + @ count type
    else
      cr ." Not defined yet!"
    then
;

: .rules
    num_rules @ 0 ?do
      i .rule
    loop
;

: th_rule
    dup 0>=
    over num_rules @ <
    and if
      cells rules_base + @
      count
    else
      cr ." Not defined yet!"
    then
;

: th_rule_use  th_rule evaluate ;

: th_rule_position
    dup 0>=
    over num_rules @ <
    and if
      dup
      rules_text_max_length * rules_text +
      swap cells rules_base +
    else
      cr abort" This rules is not defined yet!!!"
    then
;

: th_rule_text_position   th_rule_position drop ;
: th_rule_base_position   th_rule_position nip ;
: >th_rule_base           th_rule_position ! ;
: >th_rule_text ( a n i -- )    th_rule_text_position place ;
: >th_rule                dup >r >th_rule_text r> >th_rule_base ;

: all_rules_use_one_pass  num_rules @ 0 do i th_rule_use loop ;
: (->?)                   num_passes 0 do all_rules_use_one_pass loop ;

create _name_ 256 allot
create _create_fact_ 256 allot
: get_name bl word count _name_ place ;

: fact
    s" create " _create_fact_ place
    get_name
    _name_ count _create_fact_ +place
    _create_fact_ count evaluate
    here
    dup facts_list num_facts @ cells + ! 1 num_facts +!
    dup false swap c! \ for used
    dup U swap 1+ c! \ for truth value: U, F or T, initialized to U
    256 allot \ for name
    _name_ count rot 2 + place \ place name
    256 allot \ action
    256 allot \ text
;

: facts 0 do fact loop ;

: used>fact   ( used fact --)    c! ;
: uft>fact    ( uft fact -- )    1+ c! ;
: name>fact   ( "name" fact -- ) 2 + parse-name rot place ;
: action>fact ( a n fact -- )    2 + 256 + place ;
: text>fact   ( a n fact -- )    2 + 256 + 256 + place ;

: fact_used ( fact -- used) c@ ;
: fact_uft  	( fact -- uft )  1+ c@ ;
: fact_name ( fact -- a n ) 2 + count ;
: fact_action ( fact -- a n ) 2 + 256 + count ;
: fact_text ( fact -- a n ) 2 + 256 + 256 + count ;

: .uft 		( uft -- )
    dup
    U = if s" unknown" type drop exit then
    F = if s" false"  type      exit then
    s" true" type
;

: .fact_used    ( fact -- ) fact_used  .uft  ;
: .fact_uft    	( fact -- ) fact_uft   .uft  ;
: .fact_name    ( fact -- ) fact_name type ;
: .fact_action 	( fact -- ) fact_action type ;
: .fact_text  	( fact -- ) fact_text type ;
========== REMAINDER OF ARTICLE TRUNCATED ==========