Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #132738 > unrolled thread

Expert systems in forth

Back to article view | Back to comp.lang.forth

Contents

  Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-04 11:32 +0000
    Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-04 11:41 +0000
      Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-04 11:42 +0000
        Re: Expert systems in forth minforth@gmx.net (minforth) - 2025-01-04 17:46 +0000
          Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-04 19:08 +0000
            Re: Expert systems in forth mhx@iae.nl (mhx) - 2025-01-04 23:24 +0000
              Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-05 05:52 +0000
                Re: Expert systems in forth mhx@iae.nl (mhx) - 2025-01-06 14:53 +0000
                  Re: Expert systems in forth dxf <dxforth@gmail.com> - 2025-01-07 13:17 +1100
                    Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-07 06:28 +0000
                Re: Expert systems in forth marcel hendrix <mhx@iae.nl> - 2026-07-12 19:58 +0200
                  Re: Expert systems in forth dxf <dxforth@gmail.com> - 2026-07-19 15:37 +1000
                    Re: Expert systems in forth marcel hendrix <mhx@iae.nl> - 2026-07-19 18:01 +0200
                      Re: Expert systems in forth dxf <dxforth@gmail.com> - 2026-07-20 15:30 +1000
          Re: Expert systems in forth anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2025-01-05 08:49 +0000
            Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-05 11:39 +0000
              Re: Expert systems in forth anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2025-01-05 15:09 +0000
                Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-05 16:38 +0000
                  Re: Expert systems in forth anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2025-01-05 17:31 +0000
                    Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-05 18:47 +0000
                Re: Expert systems in forth albert@spenarnc.xs4all.nl - 2025-01-05 18:51 +0100
                  Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-05 19:01 +0000
                    Re: Expert systems in forth melahi_ahmed@yahoo.fr (ahmed) - 2025-01-06 00:56 +0000
                  Re: Expert systems in forth dxf <dxforth@gmail.com> - 2025-01-06 10:44 +1100

Page 1 of 2  [1] 2  Next page →

#132738 — Expert systems in forth

Hi,
For my course, I've written a "Expert System Inference Engine":
expert_systems.fs.
It works (and tested) under gforth, iForth anf vfxForth.

Here is a session using it with a simple "animal data base": animal.fs.

1. What is necessary for the animal to be a zebra?
--------------------------------------------------
zebra :-?
rule: 15
  verify:  herbivore
  verify:  ungulate
  verify:  black-stripes
 ok

2.  What is necessary for the animal to be a penguin?
-----------------------------------------------------
penguin :-?
rule: 9
  verify:  swim
  verify:  black&white
  verify:  bird
 ok

3. Assert the conditions for the animal to be a penguin:
------------------------------------------------------
swim yes  ok
black&white yes  ok
bird yes  ok
  ok

4. Forward chaining (using these asserted facts):
-------------------------------------------------
->?  ok
result
 It is a penguin. ok

5. Type the facts that are true:
-------------------------------
facts

-> true_fact:
    action: ''
    text:

-> not_fact:
    action: ''
    text:

-> swim:
    action: ''
    text:

-> bird:
    action: ''
    text:

-> black&white:
    action: ''
    text:

-> penguin:
    action: '_penguin_  cr type'
    text:
 ok

6. Clear facts (true facts will be false):
-------------------------------------
clear_facts
 ok

7. Verify that (the true_fact is always true):
----------------------------------------------
facts

-> true_fact:
    action: ''
    text:
 ok

8. Backward chaining:
---------------------
<-?

  verify:  feathers <--- yes
apparently,

apparently,

  verify:  hair <---
  verify:  give-milk <---
  verify:  eat-vegetals <---
  verify:  eat-meat <---
  verify:  pointed-teeth <---
  verify:  claws <---
  verify:  forward-eyes <---
  verify:  mammal <---
  verify:  hoofs <---
  verify:  chew-cud <---
  verify:  swim <--- yes
  verify:  black&white <--- yes
apparently,
 It is a penguin.

  verify:  long-neck <---
  verify:  not-fly <--- yes
  verify:  black-stripes <---
  verify:  carnivore <---
  verify:  tawny-color <---
  verify:  herbivore <---
  verify:  ungulate <---
  verify:  long-legs <---
  verify:  dark-spots <---
  verify:  fly-well <---
  verify:  wings <---
  verify:  fly <---
apparently,
 It is a penguin.

final result:
-------------
finally,
 It is a penguin. ok

9. Another one:
---------------
<-?

  verify:  feathers <---
  verify:  wings <--- yes
  verify:  lay-eggs <---
  verify:  hair <---
  verify:  give-milk <--- yes
apparently,

  verify:  eat-vegetals <---
  verify:  eat-meat <---
  verify:  pointed-teeth <---
  verify:  claws <---
  verify:  forward-eyes <---
  verify:  hoofs <---
  verify:  chew-cud <---
  verify:  swim <---
  verify:  black&white <---
  verify:  bird <---
  verify:  long-neck <---
  verify:  not-fly <---
  verify:  black-stripes <---
  verify:  carnivore <---
  verify:  tawny-color <---
  verify:  herbivore <---
  verify:  ungulate <---
  verify:  long-legs <---
  verify:  dark-spots <---
  verify:  fly-well <---
  verify:  fly <--- yes
apparently,
 It is a bat.

apparently,
 It is a bat.

final result:
-------------
finally,
 It is a bat. ok

10. Another one:
----------------
<-?

  verify:  feathers <--- yes
apparently,

apparently,

  verify:  hair <---
  verify:  give-milk <---
  verify:  eat-vegetals <---
  verify:  eat-meat <---
  verify:  pointed-teeth <---
  verify:  claws <---
  verify:  forward-eyes <---
  verify:  mammal <---
  verify:  hoofs <---
  verify:  chew-cud <---
  verify:  swim <---
  verify:  black&white <--- yes
  verify:  long-neck <--- yes
  verify:  not-fly <--- yes
apparently,
 It is an ostrich.

  verify:  black-stripes <---
  verify:  carnivore <---
  verify:  tawny-color <---
  verify:  herbivore <---
  verify:  ungulate <---
  verify:  long-legs <---
  verify:  dark-spots <---
  verify:  fly-well <---
  verify:  fly <---
apparently,
 It is an ostrich.

final result:
-------------
finally,
 It is an ostrich. ok

11. Another one:
----------------
<-?

  verify:  feathers <---
  verify:  wings <---
  verify:  lay-eggs <---
  verify:  hair <--- yes
apparently,

apparently,

  verify:  eat-vegetals <---
  verify:  eat-meat <--- yes
apparently,

apparently,

  verify:  hoofs <---
  verify:  chew-cud <---
  verify:  swim <---
  verify:  black&white <---
  verify:  bird <---
  verify:  long-neck <---
  verify:  not-fly <--- yes
  verify:  black-stripes <--- yes
  verify:  tawny-color <--- yes
apparently,
 It is a tiger.

  verify:  herbivore <---
  verify:  ungulate <---
  verify:  long-legs <---
  verify:  dark-spots <---
  verify:  fly-well <---
  verify:  fly <---
apparently,
 It is a tiger.

final result:
-------------
finally,
 It is a tiger. ok

12. Another one:
----------------
<-?

  verify:  feathers <---
  verify:  wings <---
  verify:  lay-eggs <---
  verify:  hair <---
  verify:  give-milk <--- yes
apparently,

  verify:  eat-vegetals <---
  verify:  eat-meat <--- yes
apparently,

apparently,

  verify:  hoofs <---
  verify:  chew-cud <---
  verify:  swim <---
  verify:  black&white <--- yes
  verify:  bird <---
  verify:  long-neck <---
  verify:  not-fly <--- yes
  verify:  black-stripes <--- yes
  verify:  tawny-color <--- yes
apparently,
 It is a tiger.

  verify:  herbivore <---
  verify:  ungulate <---
  verify:  long-legs <---
  verify:  dark-spots <--- yes
apparently,
 It is a cheetah.
 It is a tiger.

  verify:  fly-well <---
  verify:  fly <---
apparently,
 It is a cheetah.
 It is a tiger.

final result:
-------------
finally,
 It is a cheetah.
 It is a tiger. ok
  ok

13. Type the rules:
-------------------
rules
Rule n°:0 :    bird        :- feathers .;
Rule n°:1 :    bird        :- wings , lay-eggs .;
Rule n°:2 :    mammal      :- hair .;
Rule n°:3 :    mammal      :- give-milk .;
Rule n°:4 :    herbivore   :- eat-vegetals .;
Rule n°:5 :    carnivore   :- eat-meat .;
Rule n°:6 :    carnivore   :- pointed-teeth , claws , forward-eyes .;
Rule n°:7 :    ungulate    :- mammal , hoofs .;
Rule n°:8 :    ungulate    :- mammal , chew-cud .;
Rule n°:9 :    penguin     :- swim , black&white , bird , fly notfact .;
Rule n°:10 :    ostrich     :- black&white , bird , long-neck , not-fly
;
Rule n°:11 :    tiger       :- black-stripes , carnivore , tawny-color ,
mammal .;
Rule n°:12 :    giraffe     :- herbivore , long-neck , ungulate ,
long-legs , dark-spots .;
Rule n°:13 :    cheetah     :- dark-spots , tawny-color , carnivore ,
mammal .;
Rule n°:14 :    albatros    :- fly-well , bird .;
Rule n°:15 :    zebra       :- herbivore , ungulate , black-stripes .;
Rule n°:16 :    bat         :- wings , fly , mammal .; ok
  ok

14. Verify mode of chaining:
----------------------------
mode forward ok

15. Change chaining mode:
-------------------------
backward_mode  ok

16. Verify it:
--------------
mode backward ok

17. Change chaining mode:
-------------------------
forward_mode  ok

18. Verify it:
--------------
mode forward ok

19. Type true facts:
--------------------
facts

-> true_fact:
    action: ''
    text:

-> not_fact:
    action: ''
    text:

-> give-milk:
    action: 'give-milk  yes'
    text:

-> not-fly:
    action: 'not-fly  yes'
    text:

-> tawny-color:
    action: 'tawny-color  yes'
    text:

-> dark-spots:
    action: 'dark-spots  yes'
    text:

-> black&white:
    action: 'black&white  yes'
    text:

-> mammal:
    action: ''
    text:

-> black-stripes:
    action: 'black-stripes  yes'
    text:

-> carnivore:
    action: ''
    text:

-> eat-meat:
    action: 'eat-meat  yes'
    text:

-> cheetah:
    action: '_cheetah_  cr type'
    text:

-> tiger:
    action: '_tiger_    cr type'
    text:
 ok

20. Clear facts and verify it:
------------------------------
clear_facts
 ok
facts

-> true_fact:
    action: ''
    text:
 ok

Ahmed

--

[toc] | [next] | [standalone]

#132739

The animal.fs file:

include expert_systems.fs

\ facts
4 facts pointed-teeth	claws		swim			forward-eyes
4 facts hoofs			bird		give-milk		fly
4 facts hair 			chew-cud 	feathers 		lay-eggs
4 facts not-fly			tawny-color	fly-well		dark-spots
4 facts black&white		long-legs	mammal			black-stripes
4 facts carnivore		long-neck	ungulate		eat-meat
4 facts wings			bat			eat-vegetals	herbivore

4 facts cheetah	tiger	giraffe	zebra
4 facts bat		ostrich	penguin	albatros


\ rules
s" bird        :- feathers .;"                                          
         >rules
s" bird        :- wings , lay-eggs .;"                                  
         >rules
s" mammal      :- hair .;"                                              
         >rules
s" mammal      :- give-milk .;"                                         
         >rules
s" herbivore   :- eat-vegetals .;"                                      
         >rules
s" carnivore   :- eat-meat .;"                                          
         >rules
s" carnivore   :- pointed-teeth , claws , forward-eyes .;"              
         >rules
s" ungulate    :- mammal , hoofs .;"                                    
         >rules
s" ungulate    :- mammal , chew-cud .;"                                 
         >rules

s" penguin     :- swim , black&white , bird , fly notfact .;"           
         >rules
s" ostrich     :- black&white , bird , long-neck , not-fly .;"          
         >rules
s" tiger       :- black-stripes , carnivore , tawny-color , mammal .;"  
         >rules
s" giraffe     :- herbivore , long-neck , ungulate , long-legs ,
dark-spots .;"   >rules
s" cheetah     :- dark-spots , tawny-color , carnivore , mammal .;"     
         >rules
s" albatros    :- fly-well , bird .;"                                   
         >rules
s" zebra       :- herbivore , ungulate , black-stripes .;"              
         >rules
s" bat         :- wings , fly , mammal .;"                              
         >rules


\ results
: _penguin_  s"  It is a penguin."   ;
: _ostrich_  s"  It is an ostrich."  ;
: _tiger_    s"  It is a tiger."     ;
: _giraffe_  s"  It is a giraffe."   ;
: _cheetah_  s"  It is a cheetah."   ;
: _albatros_ s"  It is an albatros." ;
: _zebra_    s"  It is a zebra."     ;
: _bat_      s"  It is a bat."       ;

\ results in facts actions
s" _zebra_    cr type" zebra    action>fact
s" _albatros_ cr type" albatros action>fact
s" _cheetah_  cr type" cheetah  action>fact
s" _giraffe_  cr type" giraffe  action>fact
s" _tiger_    cr type" tiger    action>fact
s" _ostrich_  cr type" ostrich  action>fact
s" _penguin_  cr type" penguin  action>fact
s" _bat_      cr type" bat      action>fact


Ahmed

--

[toc] | [prev] | [next] | [standalone]

#132740

And the expert_systems.fs file:


\ 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]

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 false swap 1+ c! \ for tf
    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! ;
: tf>fact  	( tf 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_tf  	( fact -- tf )  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 ;

: .tf 		    ( tf -- )   if s" true " else s" false" then type ;
: .fact_used    ( fact -- ) fact_used .tf  ;
: .fact_tf    	( fact -- ) fact_tf   .tf  ;
: .fact_name    ( fact -- ) fact_name type ;
: .fact_action 	( fact -- ) fact_action type ;
: .fact_text  	( fact -- ) fact_text type ;

: .fact_name_action    ( fact -- )
    dup ." -> " .fact_name ."  : '" .fact_action ." '" cr
;

: .fact_name_text    ( fact -- )
    dup ." -> " .fact_name ."  : '" .fact_text ." '" cr
;

: .fact_name_action_text_tf ( fact -- )
     cr ." -> "           dup .fact_name   ." : "
     cr ."     action: "  dup .fact_action
     cr ."     text: "    dup .fact_text
     cr ."     t/f: "         .fact_tf
     cr
;

: .fact_name_action_text ( fact -- )
     cr ." -> "           dup .fact_name   ." : "
     cr ."     action: "  dup .fact_action
     cr ."     text: "        .fact_text
     cr
;

: .fact        ( fact -- ) .fact_name_action_text_tf ;
: .true_fact   ( fact -- ) .fact_name_action_text ;

: th_fact	( n -- fact) cells facts_list + @ ;
: .th_fact 	( n -- ) th_fact .fact ;
: .th_true_fact ( n -- ) th_fact .true_fact ;
: .all_facts 	cr num_facts @ 0 do i .th_fact loop ;

: .facts
    cr
    num_facts @ 0 do
      i th_fact fact_tf if
        i .th_true_fact
      then
    loop
;

: assert 	true  swap tf>fact ;
: retract 	false swap tf>fact ;

: clear_facts
    cr num_facts @ 1 do
	   i th_fact retract
	   false i th_fact used>fact
	loop
;

2 facts true_fact false_fact
true_fact  assert
false_fact retract

4 facts not_fact and_fact or_fact xor_fact
: not 0= ;
: notfact ( fact -- fact) fact_tf              not not_fact tf>fact
not_fact ;
: andfact ( fact1 fact2)  fact_tf swap fact_tf and and_fact tf>fact
and_fact ;
: orfact  ( fact1 fact2)  fact_tf swap fact_tf or  or_fact  tf>fact
or_fact  ;
: xorfact ( fact1 fact2)  fact_tf swap fact_tf xor xor_fact tf>fact
xor_fact ;

: variables 0 do variable loop ;

3 variables _:-   _,  _.;

: :- _:- @ execute ;
: ,  _,  @ execute ;
: .; _.; @ execute ;

3 variables f_:- f_, f_.;
4 variables b_:- b_, b__, b_.;

3 variables v_:-  v_,  v_.;
3 variables up_:- up_, up_.;
3 variables us_:- us_, us_.;

: forward_:- ( fact -- fact true) true ;
: backward_:- ( fact -- fact t/f)
    dup fact_tf if
      false
    else
      true
    then
;

: forward_, ( fact t/f fact -- fact t/f ) fact_tf and ;
: backward_, ( fact t/f fact --fact t/f)
   >r >r
   dup fact_tf 0=
   r> r>
   rot if
     dup fact_used 0= if
       dup fact_tf if
         fact_tf and
       else
         dup
         cr ."   verify:  " fact_name type
	     true over used>fact
         fact_tf and
       then
	 else
	   fact_tf and
	 then
   else
     drop
   then
;

: forward_.;  ( fact t/f fact --) , over fact_tf or swap tf>fact ;
: backward_.; ( fact t/f fact --) , over fact_tf or swap tf>fact ;

: (:-?) ( fact --)
   num_rules @ 0 do
     dup fact_name
     i th_rule drop over
     compare 0= if
       cr ." rule: " i .
       i th_rule evaluate
	   dup fact_tf if dup cr fact_name type ."  yes." then
     then
   loop
   drop
   clear_facts
;

create inference_mode 16 allot

: f_mode s" forward" inference_mode place ;
: b_mode s" backward" inference_mode place ;

: .mode inference_mode count type ;

' forward_:-  f_:- ! ' forward_,   f_, ! ' forward_.;  f_.; !
' backward_:- b_:- ! ' backward_,  b_, ! ' backward_.; b_.; !

: forward_mode   f_:- @ _:- ! f_, @ _, ! f_.; @ _.; ! f_mode ;
: backward_mode  b_:- @ _:- ! b_, @ _, ! b_.; @ _.; ! b_mode ;
backward_mode

: :-? backward_mode (:-?) ;
: ->? forward_mode  (->?) ;

: yes assert ;
: no  retract ;

: do-it
   dup fact_tf
   over fact_action nip 0<> and
   if
     fact_action evaluate
   else
     drop
   then
;

: apply_actions	num_facts @ 0 do i th_fact do-it loop ;
: .result         ->? apply_actions ( clear_facts) ;
: .partial_result ->? apply_actions ;

create xxx 256 allot
create xxxbuff 256 allot

defer <-?
: <-?_by_facts
    num_facts @ 6 do
      cr
      i th_fact fact_name type
	  i th_fact fact_name xxx place
	  s"   " xxx +place
      ."  <--- " xxxbuff 1+ 255 accept xxxbuff c!
	  xxxbuff count
	  0= if
	    0 xxx c!
	  else
	    xxxbuff count xxx +place
	  then
	  drop
      xxx count evaluate
    loop
    cr .result
;

' <-?_by_facts is <-?

: verify_fact ( fact --)
    dup >r
	fact_name xxx place
	s"   " xxx +place
    ."  <--- " xxxbuff 1+ 255 accept xxxbuff c!
	xxxbuff count
	0= if
	  0 xxx c!
	else
	  xxxbuff count xxx +place
	then
	drop
	xxx count r> fact_action drop 1- place
;

: backward__, ( fact t/f fact --fact t/f)
   >r >r
   dup fact_tf 0=
   r> r>
   rot if
     dup fact_used 0= if
       dup fact_tf if
         fact_tf and
       else
         dup
         cr ."   verify:  " fact_name type
         dup verify_fact
	     true over used>fact
	     fact_tf and
       then
	 else
	   fact_tf and
	 then
   else
     drop
   then
;

' backward_:- b_:- ! ' backward__, b__, ! ' backward_.; b_.; !
: backward_mode  b_:- @ _:- ! b_, @ _,  ! b_.; @ _.; ! b_mode ;
backward_mode

: verify_:- backward_:- ;
: verify_,  backward__, ;
: verify_.; backward_.; ;

: update_:- drop ;
: update_,  fact_action evaluate ;
: update_.; update_, ;

: use_:- backward_:- ;
: use_,  ( fact t/f fact --fact t/f)
   >r >r
   dup fact_tf 0=
   r> r>
   rot if
     fact_tf and
   else
     drop
   then
;
: use_.; backward_.; ;

' verify_:- v_:-  ! ' verify_, v_,  ! ' verify_.; v_.;  !
' update_:- up_:- ! ' update_, up_, ! ' update_.; up_.; !
' use_:-    us_:- ! ' use_,    us_, ! ' use_.;    us_.; !

: verify v_:-  @ _:- ! v_,  @ _, ! v_.;  @ _.; ! ;
: update up_:- @ _:- ! up_, @ _, ! up_.; @ _.; ! ;
: use    us_:- @ _:- ! us_, @ _, ! us_.; @ _.; ! ;

: verify_facts verify evaluate ;
: update_facts update evaluate ;
: use_facts    use    evaluate ;

0 value k
: <-?_by_rules
    clear_facts
    2 0 do i to k
      num_rules @ 0 do
        num_facts @ 6 do
          i th_fact fact_name
	  j th_rule drop over
	  compare 0= if
            j th_rule verify_facts
	    j th_rule update_facts
	    j th_rule use_facts
	    i th_fact fact_tf if
	      cr ." apparently, " .partial_result cr
	      k 1 = if
	        cr ." final result:"
                cr ." -------------"
                cr ." finally, " .result unloop unloop unloop exit
              then
            then
          then
        loop
      loop
    loop
    cr ." No results!"
;

' <-?_by_rules is <-?



Ahmed

--

[toc] | [prev] | [next] | [standalone]

#132742

Thank you for sharing your outstanding work here!

I don't think I understand the details of your program
but it seems to me way simpler than the famous Warren
Abstract Machine. IMHO your concept is very well suited
for teaching students how to approach problemss from
the ground up.

[toc] | [prev] | [next] | [standalone]

#132743

On Sat, 4 Jan 2025 17:46:55 +0000, minforth wrote:

> Thank you for sharing your outstanding work here!
>
> I don't think I understand the details of your program
> but it seems to me way simpler than the famous Warren
> Abstract Machine. IMHO your concept is very well suited
> for teaching students how to approach problemss from
> the ground up.

Thanks,

It works also under minforth MF348 (64 bit).
I had not Warren abstract machine in mind when I wrote it. I just
denfined facts, rules, forward chaining, backward chaining and some
words to interface it to set inference modes, display rules and facts.

Facts are structures with fields : name, use, true/flase, action and
text
   name: in order to recognize the fact appearing in rules,
   use : true if already used in the process of inference (false if
not), in
         order to not repeat the test if it is true or false (true/false
field).
   action: the fact can execute words if it is true,
   text: additional field for comments, other actions, ...

Rules have the form :
   goal_fact :- condition_fact1 , condition_fact2 , ... ,
condition_factn .;
   ... stands for other condition_facts
   :-
   ,
  .; are forth words

These three words are like defered words implemented with variables and
@ execute (first, I used defered words but that didn't give the good
results for iForth and vfxForth).

These words change their behavior for 3 phases:
  - forward mode
  - backward mode:
      - verify facts: the operator (user) respond by yes/no, (yes and no
are
                      defined as forth words) when prompted by:
                      verify factname <---
      - update facts: perform the actions in the facts (action field)
                      if the fact
                      is true (true/false field)
      - use    facts: perform the infernce

In forward mode, the user asserts the facts that he knows they are true
then invoke the forth word ->? to launch the inference process and with
result forth word he can display the result of the inference.

He can also use .facts forth word to see the facts that are true.

In backward mode, the user can launch the process of inference using the
forth word <-? . The infernce launched this way ask the user to verify
certain facts   (that appear in the condition part of the rules) and the
user respond with yes or no, and an empty response is considered as no,
and a response other than yes/no/empty will stop the process of
inference with an error ( undefined word).

During this inference process, the system can guess the result and
perhaps display 'Apparently: ....' followed bye a result and after some
steps it stops by 'Finally: ...' and display the result if found and if
not it displays 'No results".

The user can ask the system to give the condition facts that are
necessary to get a goal_fact true. the forth word :-? is used for that.

The user can see the rules using the forth word : .rules or for a
specific rule:
n .rule where n is the number of the rule.

For the moment, the infernce process pass through the rules one after
another in that order. Perhaps, if time permits, I'll change that using
the action field of some facts used to change the flow of the inference.

Notice here:
   <-?       backward chaining, the arrow <- in <-? is towards the left
   ->?       forward  cahining, the arrow -> in ->? is towards the right
   :-?       asking for condition facts to get a goal fact true, used
like this:
                     penguin :-?

The user can use :
    .mode : to display the current mode used (forward or backward)
    forward_mode : to set the forward mode
    backward_mode : to set the backward mode

The words <-? and ->? set the mode automatically to backward or forward
respectively.

The work is under development, and possible ideas will be used.

Ahmed

--

[toc] | [prev] | [next] | [standalone]

#132744

> (first, I used defered words but that didn't give the good
> results for iForth and vfxForth)

What went wrong?

-marcel

[toc] | [prev] | [next] | [standalone]

#132745

Hi,
First, I have the free version:

iForth version 4.0.627, generated 15:51:53, December 18, 2010.
x86_64 binary, native floating-point, extended precision.
Copyright 1996 - 2010 Marcel Hendrix.

I download it some years ago, and thanks for it.

1- For exapmple, I can't use [']  in a colon definition:
defer go

: go1 ..... ;
: use_go ['] go1 is go ;
doesn't work for me.

2- The forth word latest (gforth) is not defined in iForth:
I used latest in the definition of the forth word fact.
I modified the defintion of fact to get rid of latest.

3- The forth words place and +place are not defined in iForth:
I borrowed the definitions from gforth.

4- this for vfxForth:
The forth words 0>= and +place are not defined.

I added their definitions in the top of the expert_systems.fs file.

I changed the use of ['] in colon definitions by using variables and @
execute,
and ( @, !) instead of defer and is.

So I managed to get it working under: gforth, iForth, vfxForth anf
minforth (MF348).

Ahmed

--

[toc] | [prev] | [next] | [standalone]

#132756

On Sun, 5 Jan 2025 5:52:35 +0000, ahmed wrote:

> Hi,
> First, I have the free version:
>
> iForth version 4.0.627, generated 15:51:53, December 18, 2010.
> x86_64 binary, native floating-point, extended precision.
> Copyright 1996 - 2010 Marcel Hendrix.

Sending an e-mail address to mhx@iae.nl might cure a problem.

-marcel

[toc] | [prev] | [next] | [standalone]

#132757

On 7/01/2025 1:53 am, mhx wrote:
> On Sun, 5 Jan 2025 5:52:35 +0000, ahmed wrote:
> 
>> Hi,
>> First, I have the free version:
>>
>> iForth version 4.0.627, generated 15:51:53, December 18, 2010.
>> x86_64 binary, native floating-point, extended precision.
>> Copyright 1996 - 2010 Marcel Hendrix.
> 
> Sending an e-mail address to mhx@iae.nl might cure a problem.

A newer version of the 2005 manual posted below might help too.

https://iforth.nl/

[toc] | [prev] | [next] | [standalone]

#132758

On Tue, 7 Jan 2025 2:17:00 +0000, dxf wrote:

> On 7/01/2025 1:53 am, mhx wrote:
>> On Sun, 5 Jan 2025 5:52:35 +0000, ahmed wrote:
>>
>>> Hi,
>>> First, I have the free version:
>>>
>>> iForth version 4.0.627, generated 15:51:53, December 18, 2010.
>>> x86_64 binary, native floating-point, extended precision.
>>> Copyright 1996 - 2010 Marcel Hendrix.
>>
>> Sending an e-mail address to mhx@iae.nl might cure a problem.
>
> A newer version of the 2005 manual posted below might help too.
>
> https://iforth.nl/

Thanks for the link.

I've already seen it, read and learnt a lot from it. Thanks to Marcel.

Ahmed

--

[toc] | [prev] | [next] | [standalone]

#135237

On 1/5/2025 6:52 AM, ahmed wrote:
[..]
> 1- For exapmple, I can't use [']  in a colon definition:
> defer go
> 
> : go1 ..... ;
> : use_go ['] go1 is go ;
> doesn't work for me.

['] is fine, but you need [IS] , not IS .
> 2- The forth word latest (gforth) is not defined in iForth:
> I used latest in the definition of the forth word fact.
> I modified the defintion of fact to get rid of latest.

That is @LATEST

iSPICE> help @LATEST
@LATEST                                                         IFORTH
( -- dea )
Get the dictionary entry address of the latest header that was created
in the current wordlist (the one accessed with GET-CURRENT SET-CURRENT ) 
. ok

> 3- The forth words place and +place are not defined in iForth:
> I borrowed the definitions from gforth.

place is called PACK , +PLACE is called PLACE+ .

> So I managed to get it working under: gforth, iForth, vfxForth anf
> minforth (MF348).
> 
> Ahmed
-marcel

[toc] | [prev] | [next] | [standalone]

#135238

On 13/07/2026 3:58 am, marcel hendrix wrote:
> On 1/5/2025 6:52 AM, ahmed wrote:
> [..]
>> 3- The forth words place and +place are not defined in iForth:
>> I borrowed the definitions from gforth.
> 
> place is called PACK , +PLACE is called PLACE+ .

Presumably that's PACK DROP

Just about every forth has PLACE while hardly any have PACK.  I have both
as PACK has proven too handy e.g.

  : !fn ( a u handle -- a' u' )
    >r  -blanks  max-path umin  r> cell+ pack count  2dup upper ;

Have only seen PACK in the odd Euro forth.  Anyone know its exact origin?

[toc] | [prev] | [next] | [standalone]

#135239

On 7/19/2026 7:37 AM, dxf wrote:
> On 13/07/2026 3:58 am, marcel hendrix wrote:
>> On 1/5/2025 6:52 AM, ahmed wrote:
>> [..]
>>> 3- The forth words place and +place are not defined in iForth:
>>> I borrowed the definitions from gforth.
>>
>> place is called PACK , +PLACE is called PLACE+ .
> 
> Presumably that's PACK DROP
> 
> Just about every forth has PLACE while hardly any have PACK.  I have both
> as PACK has proven too handy e.g.
> 
>    : !fn ( a u handle -- a' u' )
>      >r  -blanks  max-path umin  r> cell+ pack count  2dup upper ;
> 
> Have only seen PACK in the odd Euro forth.  Anyone know its exact origin?
> 

PACK ( drop ) was mentioned in the BASIS documents we tracked for the 
Dutch tForth project (transputer Forth).

I have learned not to use nice names for (as yet) unstandardized 
features because the name or functionality may change.

-marcel

[toc] | [prev] | [next] | [standalone]

#135241

On 20/07/2026 2:01 am, marcel hendrix wrote:
> On 7/19/2026 7:37 AM, dxf wrote:
>> On 13/07/2026 3:58 am, marcel hendrix wrote:
>>> On 1/5/2025 6:52 AM, ahmed wrote:
>>> [..]
>>>> 3- The forth words place and +place are not defined in iForth:
>>>> I borrowed the definitions from gforth.
>>>
>>> place is called PACK , +PLACE is called PLACE+ .
>>
>> Presumably that's PACK DROP
>>
>> Just about every forth has PLACE while hardly any have PACK.  I have both
>> as PACK has proven too handy e.g.
>>
>>    : !fn ( a u handle -- a' u' )
>>      >r  -blanks  max-path umin  r> cell+ pack count  2dup upper ;
>>
>> Have only seen PACK in the odd Euro forth.  Anyone know its exact origin?
>>
> 
> PACK ( drop ) was mentioned in the BASIS documents we tracked for the Dutch tForth project (transputer Forth).
> 
> I have learned not to use nice names for (as yet) unstandardized features because the name or functionality may change.

Scanning my files I found CHForth, eForth, Mitch Bradley, had PACK.  The last
two I didn't expect.

[toc] | [prev] | [next] | [standalone]

#132746

minforth@gmx.net (minforth) writes:
>Thank you for sharing your outstanding work here!
>
>I don't think I understand the details of your program
>but it seems to me way simpler than the famous Warren
>Abstract Machine.

That would not surprise me, because Ahmed Melahi is implementing an
expert system framework, not Prolog (the progamming language for which
the WAM was designed).  Like for all other expert system examples I
have seen (several, but no production expert systems), the examples do
not include any logic variables, and I guess that his system does not
support them; the majority of the complexity of implementing Prolog
and of the WAM comes from dealing with logic variables, which can
contain structures that themselves contain logic variables.

OTOH, Ahmed Melahi's expert system framework supports forward
chaining, while Prolog does not.

Another difference is that Prolog uses the closed-world-assumption (if
there is no fact for <something>, <something> is false), while Ahmed
Melahi's framework (and expert systems in general) asks the user for
input when it does not have a fact about <something>.

Unlike expert systems examples I have seen earlier, where the rules
led to a decision tree, trying some example leads to asking
apparently-redundant questions (not answering "yes" is the same as
answering "no"), e.g.:

  verify:  feathers <---  
  verify:  wings <---  
  verify:  lay-eggs <---  
  verify:  hair <--- yes 
apparently, 

apparently, 

  verify:  eat-vegetals <---  
  verify:  eat-meat <--- yes 
apparently, 

apparently, 

  verify:  hoofs <--- yes 
apparently, 

apparently, 

  verify:  swim <--- yes 
  verify:  black&white <---  
  verify:  bird <---  
  verify:  long-neck <---  
  verify:  not-fly <--- yes 
  verify:  black-stripes <---  
  verify:  tawny-color <---  
  verify:  herbivore <---  
  verify:  long-legs <---  
  verify:  dark-spots <---  
  verify:  fly-well <---  
  verify:  fly <---  
apparently, 

final result:
-------------
finally,  ok

It seems that these additional questions are from having alternative
rules for the same thing, e.g.:

s" bird        :- feathers .;"                                          
         >rules
s" bird        :- wings , lay-eggs .;"                                  
         >rules

However, given that I answered "" (i.e., "no") to wings, there is no
reason for the system to ask me "lay-eggs".  So I think that the
redundant questions are not just due to alternative rules, but also a
shortcoming of the system.  Finally, the system could have found out
earlier (and printed more clearly that it knows of no animal that has
the properties that I answered with "yes".  As for the animal
database, the Platypus would be an interesting addition.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: https://forth-standard.org/
   EuroForth 2024: https://euro.theforth.net

[toc] | [prev] | [next] | [standalone]

#132747

Hi,
thanks for testing.

As already said in my previous post the work is under development.

The system works well taking in consideration:
   - known that the scanning of the rules is linear, it doesn't repeat
the
     same question but can ask for additional inforamtion, for example,
when
     responding to eat-vegetals by no (or empty) it can ask if it is
     herbivore, the `no' reponse doesn't change the truth of a goal fact
but
     the goal fact becomes true if all condtion facts are true.

   - when doing backward chaining, there are some results but they are
not
     displayed, for your example: it says Finally: and nothing displayed
after,
     but there are some results like: carnivore, ungulate and you can
see these
     by executing .facts which displays only the true facts. After
"Finally" the
     system executes the actions associated to the facts that are true
and in
     this case the actions associated to carnivore and ungulate but
these
     actions aren't set before (nothing in the action field of the fcats
     carnivore and ungulate).

I'll see how to change the flow of the inference using the action field
of facts and executing them during the inference, like this we can
choose the next rule to use. I think this can be possible by modifying
the words `,' and `.;'

It is up to the knowledge engineer to define how rules are scanned
(linear, predetermined or with respect to the responses given by the
user when asked to verify a fact) and this is not in expert_systems.fs
file itself but in its data base file (where facts, rules and actions
are defined) (here animal.fs).

Adding the rules for platypus :

s" platypus :- swim , not-fly , eat-meat , hoofs , hair .;" >rules

and defining the action associated to platypus:

: _paltypus_ s"  It is a platypus." ;
s" _platypus_ cr type" platypus action>fact

gives:

<-?

  verify:  feathers <---
  verify:  wings <---
  verify:  lay-eggs <---
  verify:  hair <--- yes
apparently,

apparently,

  verify:  eat-vegetals <---
  verify:  eat-meat <--- yes
apparently,

apparently,

  verify:  hoofs <--- yes
apparently,

apparently,

  verify:  swim <--- yes
  verify:  black&white <---
  verify:  bird <---
  verify:  long-neck <---
  verify:  not-fly <--- yes
  verify:  black-stripes <---
  verify:  tawny-color <---
  verify:  herbivore <---
  verify:  long-legs <---
  verify:  dark-spots <---
  verify:  fly-well <---
  verify:  fly <---
apparently,
 It is a platypus.

apparently,
 It is a platypus.

final result:
-------------
finally,
 It is a platypus. ok

Thanks again.

Ahmed

--

[toc] | [prev] | [next] | [standalone]

#132748

melahi_ahmed@yahoo.fr (ahmed) writes:
>I'll see how to change the flow of the inference using the action field
>of facts and executing them during the inference, like this we can
>choose the next rule to use.

Potential improvements:

Also have rules that work for both truth and falsness.  E.g., for
non-extinct animals, all birds have feathers and only birds have
feathers.  So if you ask the "feathers" question, and you get a "yes",
you know it is a bird, and if you get a "no", you know that it is no
bird.

And then you do not need to ask about wings and egg-laying unless the
answer is "don't know" (supporting that would be another improvement).

>s" platypus :- swim , not-fly , eat-meat , hoofs , hair .;" >rules

It seems to me that the platypus has claws, not hoofs.  The most
puzzling property of the platypus, though, is that it is a mammal and
lays eggs.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: https://forth-standard.org/
   EuroForth 2024: https://euro.theforth.net

[toc] | [prev] | [next] | [standalone]

#132749

On Sun, 5 Jan 2025 15:09:13 +0000, Anton Ertl wrote:

> melahi_ahmed@yahoo.fr (ahmed) writes:
>>I'll see how to change the flow of the inference using the action field
>>of facts and executing them during the inference, like this we can
>>choose the next rule to use.
>
> Potential improvements:
>
> Also have rules that work for both truth and falsness.  E.g., for
> non-extinct animals, all birds have feathers and only birds have
> feathers.  So if you ask the "feathers" question, and you get a "yes",
> you know it is a bird, and if you get a "no", you know that it is no
> bird.
>
> And then you do not need to ask about wings


The bat has wings and can fly and it is a mammal.



> and egg-laying unless the
> answer is "don't know" (supporting that would be another improvement).


Your example `platypus', it lays eggs, and it is not a bird.


>
>>s" platypus :- swim , not-fly , eat-meat , hoofs , hair .;" >rules
>
> It seems to me that the platypus has claws, not hoofs.  The most
> puzzling property of the platypus, though, is that it is a mammal and
> lays eggs.
>
> - anton

Until now, I assume: no equivalent to unknown.
Three level logic: yes/no/unknown (true/false/unknown)can be
implemented.
Perhaps, Carnaugh tables can be helpful.
I'll try to do it if time permits.

Ahmed

--

[toc] | [prev] | [next] | [standalone]

#132750

melahi_ahmed@yahoo.fr (ahmed) writes:
>On Sun, 5 Jan 2025 15:09:13 +0000, Anton Ertl wrote:
>
>> melahi_ahmed@yahoo.fr (ahmed) writes:
>>>I'll see how to change the flow of the inference using the action field
>>>of facts and executing them during the inference, like this we can
>>>choose the next rule to use.
>>
>> Potential improvements:
>>
>> Also have rules that work for both truth and falsness.

Or, more generally, negative rules.  Then there would be:

  bird :- feathers .;
  not bird :- not feathers .;

>> And then you do not need to ask about wings
>
>
>The bat has wings and can fly and it is a mammal.
>
>
>
>> and egg-laying unless the
>> answer is "don't know" (supporting that would be another improvement).
>
>
>Your example `platypus', it lays eggs, and it is not a bird.

I am referring to your rule

  bird        :- wings , lay-eggs .;

So if you have established that the animal has wings AND lays eggs
(and is not extinct), it's a bird.  With the negative rules one could
also specify

  not bird :- not wings .;
  not bird :- not lay-eggs .;

>Until now, I assume: no equivalent to unknown.
>Three level logic: yes/no/unknown (true/false/unknown)can be
>implemented.
>Perhaps, Carnaugh tables can be helpful.

Strangely, even though there are a lot of people working on logic in
my school, I have never heard of any work in that direction.  But I
would be very surprised if that was uncharted land.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: https://forth-standard.org/
   EuroForth 2024: https://euro.theforth.net

[toc] | [prev] | [next] | [standalone]

#132752

On Sun, 5 Jan 2025 17:31:10 +0000, Anton Ertl wrote:


> Or, more generally, negative rules.  Then there would be:
>
>   bird :- feathers .;
>   not bird :- not feathers .;

I'll see how  to do that if possible (I mean 'not' in the goal fact).


> I am referring to your rule
>
>   bird        :- wings , lay-eggs .;
>
> So if you have established that the animal has wings AND lays eggs
> (and is not extinct), it's a bird.  With the negative rules one could
> also specify
>
>   not bird :- not wings .;
>   not bird :- not lay-eggs .;
>

Your are right (Logically true), but for the moment I haven't 'not' in
the goal facts.


>>Until now, I assume: no equivalent to unknown.
>>Three level logic: yes/no/unknown (true/false/unknown)can be
>>implemented.
>>Perhaps, Carnaugh tables can be helpful.
>
> Strangely, even though there are a lot of people working on logic in
> my school, I have never heard of any work in that direction.  But I
> would be very surprised if that was uncharted land.
>
I meant multi-valued logic (three-valued logic).
and when I said Carnaugh tables, I was referring to the possibility to
consider unknown as yes or no given the situation (in the inference
process) but this is a two-valued logic. Perhaps, I was just confused.

> - anton

Ahmed

--

[toc] | [prev] | [next] | [standalone]

Page 1 of 2  [1] 2  Next page →

Back to top | Article view | comp.lang.forth

csiph-web