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> <2025Jan5.160913@mips.complang.tuwien.ac.at> <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 ==========