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