nematode.clp

介绍ANTLR使用的JAVA程序例子

(defrule start
  (declare (salience 500))
  ?init <- (initial-fact)
  =>
  (printout t "Welcome to the expert nematode diagnosis system !" crlf
            "This program can identify the following nematodes : " crlf)
  (retract ?init)
  (assert (print-list list))
  )

(defrule print-list
  (declare (salience 500))
  (print-list list)
  ?genus <- (genus ?name)
  =>
  (retract ?genus)
  (printout t "          Genus  " ?name crlf)
  )

(defrule ready
   ?print <- (print-list list)
   =>
   (retract ?print)
   (printout t "Ready to work : (yes/no) ?" crlf)
   (assert (ready =(read)))
   )

(defrule start-to-id
  ?ready <- (ready yes)
  =>
  (retract ?ready)
  (assert (query))
  )

(defrule determine-nematode
  ?query <- (query)
  (not (a nematode ?nema))
  =>
  (retract ?query)
  (printout t "Is this a nematode ?" crlf
            "(yes/no/unknown)" crlf)
  (assert (a nematode =(read)))
  )

(defrule is-a-nematode-1
  ?f1 <- (a nematode yes)
  =>
  (retract ?f1)
  (assert (this-is-a-nematode))
  )

(defrule not-a-nema
 ?f1 <- (a nematode no)
  =>
  (retract ?f1)
  (printout t "This is not a nematode. " crlf
            "This program only identifies nematodes." crlf
            "Find another one : (yes /no ) ?" crlf)
  (assert (find-another =(read)))

  )


(defrule find-another
  ?f4 <- (find-another yes)
=>
  (assert (query))
  (retract ?f4)
  )


(defrule unknown-creature
  (a nematode unknown)
  =>
  (printout t "Does it belong to any of the following shape ?" crlf crlf
            " vermiform                / pear_shaped / fusiform" crlf
            " slender,spindle_shaped  /             /  with annules" crlf
            "    unsegmented         /             /" crlf
            "  (yes / no) ?" crlf crlf)
  (assert (valid-shape =(read)))
;  (printout t "Is it bilaterally symmetrical :" crlf
;           "  (yes / no) ? " crlf)
;  (assert (bilateral =(read)))
  )

(defrule is-not-a-nema-2
  ?f1 <- (a nematode unknown)
  ?shape <- (valid-shape no)
;  ?bi <- (bilateral no)
  =>
  (printout t "This is not a nematode. " crlf
            "This program only identifies nematodes." crlf
            "Find another one : (yes / no) ?" crlf )
  (assert (find-another =(read)))
  (retract ?f1 ?shape)
;  (retract ?bi)
  )


(defrule is-a-nema-2
  ?f1 <- (a nematode unknown)
  ?shape <- (valid-shape yes)
;  ?bi <- (bilateral yes)
  =>
  (assert (this-is-a-nematode))
  (printout t "This is a nematode !" crlf)
  (retract ?f1 ?shape)
;  (retract ?bi)
  )

(defrule stylet
 (this-is-a-nematode)
 (not (stylet ?present))
 =>
 (printout t "Does it have a stylet : (present /absent) ?" crlf)
 (assert (stylet =(read)))
 )

(defrule not-a-plant-parasitic-nema
  ?stylet <- (stylet absent)
  ?nema <- (this-is-a-nematode)
  =>
  (printout t "This is not a plant parasitic nematode." crlf
            "Look for another one that has a stylet in the mouth part." crlf
            "Ready : (yes/no) ?" crlf)
  (assert (ready =(read)))
  (retract ?stylet ?nema)
  )



(defrule plant-parasitic-nema
  ?f1 <- (stylet present)
  ?f2 <- (this-is-a-nematode)
  (not (esophagus ?how-many-part))
  =>
  (retract ?f1 ?f2)
  (printout t crlf)
  (printout t "This is possibly a plant parasitic nematode. " crlf
            "Continue to identify it ." crlf crlf)
  (printout t "Look at its esophagus, is it : (two-part / three-part) ?" crlf
            "two-part :   anterior part slender" crlf
            "             posterior part glandular and muscular ." crlf crlf
            "three-part : anterior slender "crlf
            "             median bulb present" crlf
            "             posterior part : glandular basal bulb. " crlf crlf
            "Which one ?  (two-part / three-part)" crlf)
   (assert (esophagus =(read)))
   )

(defrule check-Trichorus
  (esophagus two-part)
  (not (Trichodorus ?answer))
  =>
  (printout t "Is this stylet short and curved, body short and thick "
            "(0.45-1.5 mm long) :" crlf
            "    (yes/no) ?  " crlf)
  (assert (Trichodorus =(read)))
  )

(defrule Trichodorus
  ?f3 <- (esophagus two-part)
  ?f4 <- (Trichodorus yes)
  =>
  (retract ?f3 ?f4)
  (assert (nematode Trichodorus))
  (assert (id-criteria "1. esophagus two part."
                       "2. body-shape short and thick."
                       "3. stylet-shape short and curved."))
  )

(defrule not-Trichodorus
  ?f2 <- (esophagus two-part)
  ?f1 <- (Trichodorus no)
  (not (Longidorus Xiphinema ?answer))
  =>
  (retract ?f1 ?f2)
  (printout t "Is the stylet-long, straight, tapering to a long slender point "
             crlf
            "with long extensions, body long and slender : " crlf
            " (yes / no) ? " crlf)
  (assert (Longidorus Xiphinema =(read)))
  )

(defrule Xiphinema-Logidorus
 (Longidorus Xiphinema yes)
  =>
  (printout t "Stylet extension with basal flanges and  " crlf)
  (printout t "Guiding ring in the middle of the stylet : (yes/no) ?" crlf)
  (assert (Xiphinema =(read)))
  )

(defrule Xiphinema-facts
?f1 <- (Xiphinema yes)
 =>
 (retract ?f1)
 (assert (stylet-extension with basal-flanges))
 (assert (guiding-ring middle))
 )

(defrule Longidorus-facts
?f1 <- (Xiphinema no)
 =>
 (retract ?f1)
 (assert (stylet-extension without basal-flanges))
 (assert (guiding-ring anterior))
 )



(defrule Xiphinema
  ?f1 <- (Longidorus Xiphinema yes)
  ?f3 <- (stylet-extension with basal-flanges)
  ?f4 <- (guiding-ring middle)
  =>
  (retract ?f1 ?f3 ?f4)
  (assert (nematode Xiphinema))
  (assert (id-criteria "1. esophagus two-part."
                       "2. body-shape long and slender."
                       "3. stylet-shape long, straight,
                           extension long with basal flanges."))
  )

(defrule Longidorus
  ?f1 <- (Longidorus Xiphinema yes)
  ?f3 <- (stylet-extension without basal-flanges)
  ?f4 <- (guiding-ring anterior)
  =>
  (retract ?f1  ?f3 ?f4)
  (assert (nematode Longidorus))
  (assert (id-criteria "1. esophagus two-part."
                       "2. body-shape long and slender."
                       "3. stylet-shape long, straight,
                           extension long without basal flanges."))
  )

(defrule unknown-feeding-habits-nema
  ?f1 <- (Longidorus Xiphinema no)
  =>
  (retract ?f1)
  (assert (nematode "A large number of genera, feeding habits unknown."))
  (assert (id-criteria "1. esophagus two-part."
                       "2. stylet straight, usually not very long."
                       "3. body normal."))
  )

(defrule median-bulb-size
  (esophagus three-part)
  (not (median-bulb ?size))
  =>
  (printout t "What is the size of the median bulb ?" crlf crlf
            " 1. as wide as the diameter of the body width. " crlf
            " 2. less than 3/4 body width . " crlf )
   (assert (median-bulb =(read)))
   )

(defrule metacorpus-small
 ?bulb <- (median-bulb 2)
 =>
 (retract ?bulb)
 (assert (median-bulb small))
 )

(defrule metacorpus-large
 ?bulb <- (median-bulb 1)
 =>
 (retract ?bulb)
 (assert (median-bulb large))
 )


(defrule Aphelenchoidea
  ?f1 <- (esophagus three-part)
  ?f2 <- (median-bulb large)
  (not (Superfamily Aphelenchoidea))
  =>
  (retract ?f1 ?f2)
  (assert (Superfamily Aphelenchoidea))
  )

(defrule Tylenchoidea
  ?f1 <- (esophagus three-part)
  ?f2 <- (median-bulb small)
  (not (Superfamily Tylenchoidea))
  =>
  (retract ?f1 ?f2)
  (assert (Superfamily Tylenchoidea))
  )

(defrule Aphelenchoidea-tail-shape
  (Superfamily Aphelenchoidea)
  (not (tail-shape ?size))
  =>
  (printout t "Shape of tail : (blunt or conoid) ? " crlf)
  (assert (tail-shape =(read)))
  )

(defrule Aphelenchus
  ?f1 <- (Superfamily Aphelenchoidea)
  ?f2 <- (tail-shape blunt)
  =>
  (retract ?f1 ?f2)
  (assert (nematode Aphelenchus))
  (assert (id-criteria "1. esophagus three-part."
                       "2. metacorpus large."
                       "3. female tail-shape blunt."))
  )

(defrule Aphelenchoides
  ?f1 <- (Superfamily Aphelenchoidea)
  ?f2 <- (tail-shape conoid)
  =>
  (retract ?f1 ?f2)
  (assert (nematode Aphelenchoides))
  (assert (id-criteria "1. esophagus three-part."
                       "2. metacorpus large."
                       "3. tail-shape conoid, with 1 or more sharp points."))
 )

(defrule annulated-cuticle
  ?f1 <- (Superfamily Tylenchoidea)
  (not (cuticle-annulated-heavily ?any))
  =>
  (retract ?f1)
  (printout t "Is the cuticle heavily annulated ? (yes / no) : " crlf)
  (assert (cuticle-annulated-heavily =(read)))
  )

(defrule Criconematidae
  ?f2 <- (cuticle-annulated-heavily yes)
  (not (Family Criconematidae))
  =>
  (retract ?f2)
  (assert (Family Criconematidae))
  )

(defrule cuticle-sheath
  ?f3 <- (Family Criconematidae)
  (not (cuticle-sheath ?any))
  =>
  (retract ?f3)
  (printout t "Does the body have prominent cuticle sheath ? "
            "     (present / absent) ? " crlf)
  (assert (cuticle-sheath =(read)))
  )

(defrule Hemicriconemoides
  ?f4 <- (cuticle-sheath present)
  =>
  (retract ?f4)
  (assert (nematode Hemicriconemoides))
  (assert (id-criteria "1. esophagus three-part, metacorpus small."
                       "2. cuticle heavily annulated."
                       "3. cuticle-sheath prominent."))
 )

(defrule Criconema-Criconemoides
  ?f5 <- (cuticle-sheath absent)
  (not (annules-posterior-projections ?any))
  =>
  (retract ?f5)
  (printout t "Does the annules have prominent posterior projections ?" crlf
            "               (yes / no) " crlf )
  (assert (annules-posterior-projections = (read)))
  )

(defrule Criconema
  ?f6 <- (annules-posterior-projections yes)
  =>
  (retract ?f6)
  (assert (nematode Criconema))
  (assert (id-criteria "1. esophagus three-part, metacorpus small."
                       "2. cuticle-sheath absent."
                       "3. cuticle-annules with  posterior projections."))
 )

(defrule Criconemoides
  ?f7 <- (annules-posterior-projections no)
  =>
  (retract ?f7)
  (assert (nematode Criconemoides))
  (assert (id-criteria "1. esophagus three-part, metacorpus small."
                       "2. cuticle-sheath absent."
                       "3. heavy annulations, without posterior projections."))
 )

(defrule enlarge-body
  ?f8 <- (cuticle-annulated-heavily no)
  (not (female-body-shape ?any))
  =>
  (retract ?f8)
  (printout t "What is the female body shape :" crlf
            "1. pyriform-saccate or lemon-shaped ?" crlf
            "2. elongate-saccate or kidney-shape with tail ?" crlf
            "3. cylindrical ?" crlf)

  (assert (female-body-shape =(read)))
  )

(defrule female-body-shape-1
  ?f1 <- (female-body-shape 1)
  =>
  (assert (female-body-shape pyriform-saccate-or-lemon-shape))
  (retract ?f1)
 )

(defrule female-body-shape-2
  ?f2 <- (female-body-shape 2)
  =>
  (assert (female-body-shape elongate-saccate-or-kidney-shape-with-tail))
  (retract ?f2)
 )


(defrule female-body-shape-3
  ?f3 <- (female-body-shape 3)
  =>
  (assert (female-body-shape cylindrical))
  (retract ?f3)
 )
(defrule Heteroderidae
  ?f1 <- (female-body-shape pyriform-saccate-or-lemon-shape)
  (not (Family Heteroderidae))
  =>
  (retract ?f1)
  (assert (Family Heteroderidae))
  )

(defrule body-hardness
  (Family Heteroderidae)
  (not (female-body ?any))
  =>
  (printout t "Is the female body hard or soft, test with a needle : "
             " (hard /soft) ?" crlf)
  (assert (female-body = (read)))
  )

(defrule Heterodera
  ?f1 <- (Family Heteroderidae)
  ?f2 <- (female-body hard)
  =>
   (retract ?f1 ?f2)
  (assert (nematode Heterodera))
  (assert (id-criteria "1. esophagus three-part, metacorpus small."
                       "2. female-body lemon-shape."
                       "3. female-body hard-cyst."))
 )

(defrule Meloidodera-Meloidogyne
  (Family Heteroderidae)
  ?f1 <- (female-body soft)
  (not (vulva-position ?any))
  =>
  (retract ?f1)
  (printout t "Where is the position of vulva ?" crlf
            "1. terminal of nearly so." crlf
            "2. slightly posterior to middle of body." crlf
            "   1 or 2 " crlf)
  (assert (vulva-position =(read)))
   )

(defrule vulva-position-terminal
?pos <- (vulva-position 1)
=>
(retract ?pos)
(assert (vulva-position terminal))
)

(defrule vulva-position-middle
?pos <- (vulva-position 2)
=>
(retract ?pos)
(assert (vulva-position middle))
)


(defrule Meloidogyne
  ?f1 <- (Family Heteroderidae)
  ?f2 <- (vulva-position terminal)
  =>
   (retract ?f1 ?f2)
  (assert (nematode Meloidogyne))
  (assert (id-criteria "1. esophagus three-part, metacorpus small."
                       "2. female-body pear-shape, soft."
                       "3. vulva-position terminal of body."))
 )

(defrule Meloidodera
  ?f1 <- (Family Heteroderidae)
  ?f2 <- (vulva-position middle)
  =>