home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0600 / CCE_0622.ZIP / CCE_0622.PD / CLIPS / WINE.CLP < prev   
Text File  |  1993-09-01  |  11KB  |  448 lines
  1.  
  2. ;; math.c extended package must be linked with clips
  3. ;; for this example to work
  4.  
  5. (defrule choose-body-for-spicy-sauce ""
  6.   (declare (salience 1000))
  7.   (has-sauce yes)
  8.   (sauce spicy)
  9.   =>
  10.   (assert (best-body full 100 =(gensym))))
  11.  
  12. (defrule choose-body-for-delicate-taste "" 
  13.   (declare (salience 1000))
  14.   (tastiness delicate)
  15.   =>
  16.   (assert (best-body light 100 =(gensym))))
  17.  
  18. (defrule choose-body-for-average-taste ""
  19.   (declare (salience 1000))
  20.   (tastiness average)
  21.   =>
  22.   (assert (best-body light 30 =(gensym)))
  23.   (assert (best-body medium 60 =(gensym)))
  24.   (assert (best-body full 30 =(gensym))))
  25.  
  26. (defrule choose-body-for-strong-taste ""
  27.   (declare (salience 1000))
  28.   (tastiness strong)
  29.   =>
  30.   (assert (best-body medium 40 =(gensym)))
  31.   (assert (best-body full 80 =(gensym))))
  32.  
  33. (defrule choose-body-for-cream-sauce ""
  34.   (declare (salience 1000))
  35.   (has-sauce yes)
  36.   (sauce cream)
  37.   =>
  38.   (assert (best-body medium 40 =(gensym)))
  39.   (assert (best-body full 60 =(gensym))))
  40.  
  41. (defrule choose-color-for-meat ""
  42.   (declare (salience 1000))
  43.   (main-component meat)
  44.   (has-veal no)
  45.   =>
  46.   (assert (best-color red 90 =(gensym))))
  47.  
  48. (defrule choose-color-for-poultry ""
  49.   (declare (salience 1000))
  50.   (main-component poultry)
  51.   (has-turkey no)
  52.   =>
  53.   (assert (best-color white 90 =(gensym)))
  54.   (assert (best-color red 30 =(gensym))))
  55.  
  56. (defrule choose-color-for-fish ""
  57.   (declare (salience 1000))
  58.   (main-component fish)
  59.   =>
  60.   (assert (best-color white 100 =(gensym))))
  61.  
  62. (defrule choose-color-for-tomato-sauce ""
  63.   (declare (salience 1000))
  64.   (not (main-component fish))
  65.   (has-sauce yes)
  66.   (sauce tomato)
  67.   =>
  68.   (assert (best-color red 100 =(gensym))))
  69.  
  70. (defrule choose-color-for-turkey ""
  71.   (declare (salience 1000))
  72.   (main-component poultry)
  73.   (has-turkey yes)
  74.   =>
  75.   (assert (best-color red 80 =(gensym)))
  76.   (assert (best-color white 50 =(gensym))))
  77.  
  78. (defrule choose-color-for-cream-sauce ""
  79.   (declare (salience 1000))
  80.   (main-component unknown)
  81.   (has-sauce yes)
  82.   (sauce cream)
  83.   =>
  84.   (assert (best-color white 40 =(gensym))))
  85.  
  86. (defrule choose-color-for-sweet-sauce ""
  87.   (declare (salience 1000))
  88.   (has-sauce yes)
  89.   (sauce sweet)
  90.   =>
  91.   (assert (best-sweetness sweet 90 =(gensym)))
  92.   (assert (best-sweetness medium 40 =(gensym))))
  93.  
  94. (defrule spicy-sauce-is-spicy-feature ""
  95.   (declare (salience 1000))
  96.   (has-sauce yes)
  97.   (sauce spicy)
  98.   =>
  99.   (assert (feature spiciness)))
  100.  
  101. (defrule rule-14 ""
  102.   (declare (salience 1000))
  103.   (best-body ?body ?per ?)
  104.   =>
  105.   (assert (recommended-body ?body ?per =(gensym))))
  106.  
  107. (defrule rule-17 ""
  108.   (declare (salience 1000))
  109.   (preferred-body ?body)
  110.   (best-body ?body ?per ?)
  111.   =>
  112.   (assert (recommended-body ?body =(/ (* 20 ?per) 100) =(gensym))))
  113.  
  114. (defrule rule-20 ""
  115.   (declare (salience 1000))
  116.   (preferred-body light)
  117.   (best-body full ?per ?)
  118.   =>
  119.   (assert (recommended-body medium ?per =(gensym))))
  120.  
  121. (defrule rule-21 ""
  122.   (declare (salience 1000))
  123.   (preferred-body full)
  124.   (best-body light ?per ?)
  125.   =>
  126.   (assert (recommended-body medium ?per =(gensym))))
  127.  
  128. (defrule use-prefered-body-if-no-best-body ""
  129.   (preferred-body ?body)
  130.   (not (best-body ? ? ?))
  131.   =>
  132.   (assert (recommended-body ?body 100 =(gensym))))    
  133.  
  134. (defrule use-medium-body-if-no-best-body ""
  135.   (not (best-body ? ? ?))
  136.   =>
  137.   (assert (recommended-body medium 100 =(gensym))))
  138.  
  139. (defrule rule-26 ""
  140.   (declare (salience 1000))
  141.   (best-color ?color ?per ?)
  142.   =>
  143.   (assert (recommended-color ?color ?per =(gensym))))
  144.  
  145. (defrule rule-28 ""
  146.   (declare (salience 1000))
  147.   (preferred-color ?color)
  148.   (best-color ?color ?per ?)
  149.   =>
  150.   (assert (recommended-color ?color =(/ (* 20 ?per) 100) =(gensym))))
  151.  
  152. (defrule use-preferred-color-if-no-best-color ""
  153.   (preferred-color ?color)
  154.   (not (best-color ? ? ?))
  155.   =>
  156.   (assert (recommended-color ?color 100 =(gensym))))
  157.  
  158. (defrule preferred-color-is-unknown ""
  159.   (declare (salience 1000))
  160.   (preferred-color unknown)
  161.   =>
  162.   (assert (recommended-color white 50 =(gensym)))
  163.   (assert (recommended-color red 50 =(gensym))))
  164.  
  165. (defrule rule-33 ""
  166.   (declare (salience 1000))
  167.   (best-sweetness ?sweet ?per ?)
  168.   =>
  169.   (assert (recommended-sweetness ?sweet ?per =(gensym))))
  170.  
  171. (defrule rule-36 ""
  172.   (not (best-sweetness ? ? ?))
  173.   (preferred-sweetness unknown)
  174.   =>
  175.   (assert (recommended-sweetness medium 100 =(gensym))))
  176.  
  177. (defrule rule-37 ""
  178.   (declare (salience 1000))
  179.   (best-sweetness ?sweet ?per ?)
  180.   (preferred-sweetness ?sweet)
  181.   =>
  182.   (assert (recommended-sweetness ?sweet =(/ (* 20 ?per) 100) =(gensym))))
  183.  
  184. (defrule rule-40 ""
  185.   (not (best-sweetness ? ? ?))
  186.   (preferred-sweetness ?sweet)
  187.   =>
  188.   (assert (recommended-sweetness ?sweet 100 =(gensym))))
  189.  
  190. (defrule rule-43 ""
  191.   (declare (salience 1000))
  192.   (best-sweetness sweet ?per ?)
  193.   (preferred-sweetness dry)
  194.   =>
  195.   (assert (recommended-sweetness medium ?per =(gensym))))
  196.  
  197. (defrule rule-44 ""
  198.   (declare (salience 1000))
  199.   (best-sweetness dry ?per ?)
  200.   (preferred-sweetness sweet)
  201.   =>
  202.   (assert (recommended-sweetness medium ?per =(gensym))))
  203.  
  204. (defrule recommend-gamay ""
  205.   (declare (salience -1000))
  206.   (recommended-color red ?per1 ?)
  207.   (recommended-body medium ?per2 ?)
  208.   (or (recommended-sweetness medium ?per3 ?)
  209.       (recommended-sweetness sweet ?per3 ?))
  210.   =>
  211.   (assert (wine gamay =(min ?per1 ?per2 ?per3) =(gensym))))
  212.  
  213. (defrule recommend-chablis ""
  214.   (declare (salience -1000))
  215.   (recommended-color white ?per1 ?)
  216.   (recommended-body light ?per2 ?)
  217.   (recommended-sweetness dry ?per3 ?)
  218.   =>
  219.   (assert (wine chablis =(min ?per1 ?per2 ?per3) =(gensym))))
  220.  
  221. (defrule recommend-sauvignon-blanc ""
  222.   (declare (salience -1000))
  223.   (recommended-color white ?per1 ?)
  224.   (recommended-body medium ?per2 ?)
  225.   (recommended-sweetness dry ?per3 ?)
  226.   =>
  227.   (assert (wine sauvignon-blanc =(min ?per1 ?per2 ?per3) =(gensym))))
  228.  
  229. (defrule recommend-chardonnay ""
  230.   (declare (salience -1000))
  231.   (recommended-color white ?per1 ?)
  232.   (or (recommended-body  medium ?per2 ?)
  233.       (recommended-body  full ?per2 ?))
  234.   (or (recommended-sweetness medium ?per3 ?)
  235.       (recommended-sweetness dry ?per3 ?))
  236.   =>
  237.   (assert (wine chardonnay =(min ?per1 ?per2 ?per3) =(gensym))))
  238.  
  239. (defrule recommend-soave ""
  240.   (declare (salience -1000))
  241.   (recommended-color white ?per1 ?)
  242.   (recommended-body light ?per2 ?)
  243.   (or (recommended-sweetness medium  ?per3 ?)
  244.       (recommended-sweetness dry ?per3 ?))
  245.   =>
  246.   (assert (wine soave =(min ?per1 ?per2 ?per3) =(gensym))))
  247.  
  248. (defrule recommend-riesling ""
  249.   (declare (salience -1000))
  250.   (recommended-color white ?per1 ?)
  251.   (or (recommended-body light ?per2 ?)
  252.       (recommended-body medium ?per2 ?))
  253.   (or (recommended-sweetness medium ?per3 ?)
  254.       (recommended-sweetness sweet ?per3 ?))
  255.   =>
  256.   (assert (wine riesling =(min ?per1 ?per2 ?per3) =(gensym))))
  257.  
  258. (defrule recommend-geverztraminer ""
  259.   (declare (salience -1000))
  260.   (recommended-color white ?per1 ?)
  261.   (recommended-body full ?per2 ?)
  262.   (feature spiciness)
  263.   =>
  264.   (assert (wine geverztraminer =(min ?per1 ?per2) =(gensym))))
  265.  
  266. (defrule recommend-chenin-blanc ""
  267.   (declare (salience -1000))
  268.   (recommended-color white ?per1 ?)
  269.   (recommended-body light ?per2 ?)
  270.   (or (recommended-sweetness medium ?per3 ?)
  271.       (recommended-sweetness sweet ?per3 ?))
  272.   =>
  273.   (assert (wine chenin-blanc =(min ?per1 ?per2 ?per3) =(gensym))))
  274.  
  275. (defrule recommend-valpolicella ""
  276.   (declare (salience -1000))
  277.   (recommended-color red ?per1 ?)
  278.   (recommended-body light ?per2 ?)
  279.   =>
  280.   (assert (wine valpolicella =(min ?per1 ?per2) =(gensym))))
  281.  
  282. (defrule recommend-zinfandel-and-cabernet-sauvignon ""
  283.   (declare (salience -1000))
  284.   (recommended-color red ?per1 ?)
  285.   (or (recommended-sweetness medium ?per2 ?)
  286.       (recommended-sweetness dry  ?per2 ?))
  287.   =>
  288.   (assert (wine cabernet-sauvignon =(min ?per1 ?per2) =(gensym)))
  289.   (assert (wine zinfandel =(min ?per1 ?per2) =(gensym))))
  290.  
  291. (defrule recommend-pinot-noir ""
  292.   (declare (salience -1000))
  293.   (recommended-color red ?per1 ?)
  294.   (recommended-body medium ?per2 ?)
  295.   (recommended-sweetness medium ?per3 ?)
  296.   =>
  297.   (assert (wine pinot-noir =(min ?per1 ?per2 ?per3) =(gensym))))
  298.  
  299. (defrule recommend-burgundy ""
  300.   (declare (salience -1000))
  301.   (recommended-color red ?per1 ?)
  302.   (recommended-body full ?per2 ?)
  303.   =>
  304.   (assert (wine burgundy =(min ?per1 ?per2) =(gensym))))
  305.  
  306. ;;
  307. ;; question 1
  308. ;;
  309.  
  310. (defrule question-1 ""
  311.   (declare (salience 9900))
  312.   (initial-fact)
  313.   =>
  314.   (printout crlf "Is the main component of the meal meat, fish, or poultry? ")
  315.   (assert (main-component =(read))))
  316.  
  317. ;;
  318. ;; question 2
  319. ;;
  320.  
  321. (defrule question-2 ""
  322.   (declare (salience 9800))
  323.   (main-component poultry)
  324.   =>
  325.   (printout "Does the meal have turkey in it? ")
  326.   (assert (has-turkey =(read))))
  327.  
  328. ;;
  329. ;; question 3
  330. ;;
  331.  
  332. (defrule question-3 ""
  333.   (declare (salience 9700))
  334.   (main-component meat)
  335.   =>
  336.   (printout "Does the meal have veal in it? ")
  337.   (assert (has-veal =(read))))
  338.  
  339. ;;
  340. ;; question 4
  341. ;;
  342.  
  343. (defrule question-4 ""
  344.   (declare (salience 9600))
  345.   (initial-fact)
  346.   =>
  347.   (printout "Does the meal have a sauce on it? ")
  348.   (assert (has-sauce =(read))))
  349.  
  350. ;;
  351. ;; question 5
  352. ;;
  353.  
  354. (defrule question-5 ""
  355.   (declare (salience 9500))
  356.   (has-sauce yes)
  357.   =>
  358.   (printout "Is the sauce for the meal spicy, sweet, cream, or tomato? ")
  359.   (assert (sauce =(read))))
  360.  
  361. ;;
  362. ;; question 6
  363. ;;
  364.  
  365. (defrule question-6 ""
  366.   (declare (salience 9400))
  367.   (initial-fact)
  368.   =>
  369.   (printout "Is the flavor of the meal delicate, average, or strong? ")
  370.   (assert (tastiness =(read))))
  371.  
  372. ;;
  373. ;; question 7
  374. ;;
  375.  
  376. (defrule question-7 ""
  377.   (declare (salience 9300))
  378.   (initial-fact)
  379.   =>
  380.   (printout "Do you generally prefer light, medium, or full bodied wines? ")
  381.   (assert (preferred-body =(read))))
  382.  
  383. ;;
  384. ;; question 8
  385. ;;
  386.  
  387. (defrule question-8 ""
  388.   (declare (salience 9200))
  389.   (initial-fact)
  390.   =>
  391.   (printout "Do you generally prefer red or white wines? ")
  392.   (assert (preferred-color =(read))))
  393.  
  394. ;;
  395. ;; question 9
  396. ;;
  397.  
  398. (defrule question-9 ""
  399.   (declare (salience 9100))
  400.   (initial-fact)
  401.   =>
  402.   (printout "Do you generally prefer dry, medium, or sweet wines? ")
  403.   (assert (preferred-sweetness =(read))))
  404.  
  405. (defrule print-wine ""
  406.   (declare (salience -6000))
  407.   ?rem <- (wine ?name ?per ?)
  408.   (not (wine ?name1 ?per1&:(> ?per1 ?per) ?))
  409.   =>
  410.   (retract ?rem)
  411.   (printout "wine " ?name " " ?per crlf))
  412.  
  413. ;;
  414. ;; percent rule 1
  415. ;;
  416.  
  417. (defrule percent-rule-1 ""
  418.   (declare (salience -5000))
  419.   ?rem <- (? ? ?per ?)
  420.   (test (< ?per 20))
  421.   =>
  422.   (retract ?rem))
  423.  
  424. ;;
  425. ;; percent rule 2
  426. ;;
  427.  
  428. (defrule percent-rule-2 ""
  429.   (declare (salience 10000))
  430.   ?rem1 <- (?rel ?val ?per1 ?sym1)
  431.   ?rem2 <- (?rel ?val ?per2 ?sym2&~?sym1)
  432.   =>
  433.   (retract ?rem1 ?rem2)
  434.   (assert (?rel ?val
  435.         =(/ (- (* 100 (+ ?per1 ?per2)) (* ?per1 ?per2)) 100)
  436.         =(gensym))))
  437.  
  438.  
  439.  
  440.  
  441.  
  442.  
  443.  
  444.  
  445.  
  446.  
  447.  
  448.