home bbs files messages ]

Forums before death by AOL, social media and spammers... "We can't have nice things"

   comp.lang.forth      Forth programmers eat a lot of Bratwurst      117,927 messages   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]

   Message 116,998 of 117,927   
   ahmed to All   
   Re: Expert systems in forth (2/2)   
   06 Jan 25 00:56:37   
   
   [continued from previous message]   
      
            fact_uft and3   
          then   
        else   
          fact_uft and3   
        then   
      else   
        drop   
      then   
      
      
   : forward_.;  ( fact u/f/t fact --) , over fact_uft imply3 swap uft>fact   
      
   : backward_.; ( fact u/f/t fact --) , over fact_uft imply3 swap uft>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_uft   
          T = 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   
      
   : :-? clear_facts backward_mode (:-?) ;   
   : ->? forward_mode  (->?) ;   
      
   : yes     assert ;   
   : no      retract ;   
   \ : uknown  unkown  ;   
      
   : do-it ( fact -- )   
      dup fact_uft T =   
      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 u/f/t fact --fact u/f/t)   
      >r >r   
      dup fact_uft dup F = swap U = or3   
      r> r>   
      rot T <> if   
        dup fact_used not if   
          dup fact_uft U <> if   
            fact_uft and3   
          else   
            dup   
            cr ."   verify:  " fact_name type   
            dup verify_fact   
   	     true over used>fact   
   	     fact_uft and3   
          then   
        else   
          fact_uft and3   
        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 u/f/t fact --fact u/f/t)   
      >r >r   
      dup fact_uft dup F = swap U = or3   
      r> r>   
      rot T <> if   
        fact_uft and3   
      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_uft T = 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 <-?   
      
      
   ----- The code terminates here   
      
   The user can respond by: yes, no or unknown.   
   An empty response is considered as unknown.   
      
   Ahmed   
      
   --   
      
   --- SoupGate-DOS v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]


(c) 1994,  bbs@darkrealms.ca