wxsys-25.txt

一套美国国家宇航局人工智能中心NASA的专家系统工具源代码

;***********************************************************************
; WXSYS.CLP, Version of October, 1997
;
;   A rule-based expert system to predict local weather changes based 
;   on documented weather lore, and taking into account both current
;   (crisp) conditions such as humidity, wind speed, and barometric
;   pressure, as well as human (fuzzy) observations of current, local
;   phenomena.
;
;   requires FuzzyCLIPS version 6.0.4 or later
;
;   (c) 1997 by the authors:

;   Walter Maner, Ph.D.
;   Department of Computer Science, Bowling Green State University
;   Bowling Green, Ohio
;   email:  [e-mail]
;
;   Sean Joyce, M.S.
;   Department of Computer Science, Heidelberg College
;   Tiffin, Ohio
;   email:  [e-mail]
;***********************************************************************

;***********************************************************************
;Note:  This program requires that the corresponding fuzzy modifer   
;       ("hedge") definition file "HEDGES.BAT" be loaded with the
;
;                 (batch "HEDGES.BAT")
;
;       command prior to loading this file.
;***********************************************************************

;Written for use with the FuzzyCLIPS fuzzy expert system/AI shell.
;FuzzyCLIPS was developed by the National Research Council (NRC)
;Canada.  FuzzyCLIPS can be obtained from

;     Institute for Information Technology
;     National Research Council Canada
;     Ottawa, Ontario Canada K1A 0R6

;For more information on FuzzyCLIPS, see    
;<http://ai.iit.nrc.ca/fuzzy/fuzzy.html>.

;FuzzyCLIPS is an extension of the CLIPS rule-based AI shell,
;developed by the Artificial Intelligence Section, Lyndon B.
;Johnson Space Center, NASA.  CLIPS can be obtained from

;     COSMIC
;     The University of Georgia
;     382 Broad Street
;     Athens, GA 30602

;For more information on CLIPS, see
;<http://www.jsc.nasa.gov/~clips/CLIPS.html>.


;*****
;Notes on program inputs
;*****

;Most data inputs (crisp) are assumed to come from weather
;sensors on a computer, and are input using a batch file.
;Remaining data inputs (fuzzy) are assumed to come from
;observation by humans, and are either included in the batch
;file or are elicited by user response to program-generated
;questions.  Observations of current conditions plus a report
;of conditions 3 hours ago are solicited from the user.

;The forecast is intended to be valid for the local area
;only (and valid is a fuzzy term!), and is a short-term 
;forecast for the next 24 hours.

;General trend forecasts are limited to:
;    (a) no-change-in-weather
;    (b) change-in-weather.

;Detailed weather forecasts are limited to:
;    (a) dry-period
;    (b) dry-period-ending
;    (c) wet (includes snow)
;    (d) wet-period-ending
;    (e) stormy-period
;    (f) stormy-period-ending.



;************************************************************
;*                     MODULE:  MAIN                        *
;************************************************************

(defmodule MAIN (export ?ALL)) 

;**********
;Deftemplates for input data.
;**********

(deftemplate new-data-from-user
  (multislot primary-cloud-base (default unasked))
             ;will consist of "low," "middle," or "high,"
             ;possibly preceeded by one or two "very" modifiers
  (multislot primary-cloud-orientation (default unasked))
             ;will consist of "vertical" or "horiontal,"
             ;possibly preceeded by one or two "very" modifiers
  (slot      primary-clouds-moving-from (default unasked)
             (allowed-values unasked
                             not-applicable
                             unknown
                             north
                             northeast
                             east
                             southeast
                             south
                             southwest
                             west
                             northwest))
  (multislot secondary-cloud-base (default unasked))
             ;will consist of "low," "middle," or "high,"
             ;possibly preceeded by one or two "very" modifiers
             ;NOTE:  the "secondary cloud base" series of facts
             ;       are unused by prediction rules at this
             ;       time, but are included for possible future use
  (multislot secondary-cloud-orientation (default unasked))
             ;will consist of "vertical" or "horiontal,"
             ;possibly preceeded by one or two "very" modifiers
  (slot      secondary-clouds-moving-from (default unasked)
             (allowed-values unasked
                             not-applicable
                             unknown
                             north
                             northeast
                             east
                             southeast
                             south
                             southwest
                             west
                             northwest))
  (slot      cloud-cover (default unasked)
             (allowed-values unasked
                             clear
                             partly-cloudy
                             cloudy
                             mostly-cloudy
                             overcast)))
                             
(deftemplate old-data-from-user
  (multislot primary-cloud-base (default unasked))
  (multislot primary-cloud-orientation (default unasked))
  (slot      primary-clouds-moving-from (default unasked)
             (allowed-values unasked
                             not-applicable
                             unknown
                             north
                             northeast
                             east
                             southeast
                             south
                             southwest
                             west
                             northwest))
  (multislot secondary-cloud-base (default unasked))
  (multislot secondary-cloud-orientation (default unasked))
  (slot      secondary-clouds-moving-from (default unasked)
             (allowed-values unasked
                             not-applicable
                             unknown
                             north
                             northeast
                             east
                             southeast
                             south
                             southwest
                             west
                             northwest))
  (slot      cloud-cover (default unasked)
             (allowed-values unasked
                             clear
                             partly-cloudy
                             cloudy
                             mostly-cloudy
                             overcast)))
                             
(deftemplate new-data-from-computer
  (slot time-of-day
        (type INTEGER)
        (range 0 23))
  (slot month
        (type INTEGER)
        (range 1 12))
  (slot day-of-month
        (type INTEGER)
        (range 1 31))
  (slot wind-speed
        (type INTEGER)
        (range 0 150))	
        ; miles per hour
  (slot wind-from
        (type INTEGER)
        (range 0 359))
        ; compass degrees
  (slot barometric-pressure
        (type FLOAT)
        (range 28.0 32.0))
        ; inches of mercury
  (slot relative-humidity
        (type INTEGER)
        (range 0 100)))
        ; percentage humidity
        
(deftemplate old-data-from-computer
  (slot time-of-day
        (type INTEGER)
        (range 0 23))
  (slot month
        (type INTEGER)
        (range 1 12))
  (slot day-of-month
        (type INTEGER)
        (range 1 31))
  (slot wind-speed
        (type INTEGER)
        (range 0 150))
  (slot wind-from
        (type INTEGER)
        (range 0 359))
  (slot barometric-pressure
        (type FLOAT)
        (range 28.0 32.0))
  (slot relative-humidity
        (type INTEGER)
        (range 0 100)))
        
;**********
;Determine whether new data needs to be input by the user.
;(i.e. Has the new-data-from-user fact already been asserted, or
;      do we need to ask for it?)
;**********

(defrule initial-new-data
  (declare (salience 1))
  (not (exists (new-data-from-user)))
  =>
  (assert (new-data-from-user (primary-cloud-base unasked)
                              (primary-cloud-orientation unasked))))
                  
;**********
;Determine whether old data needs to be input by the user.
;**********

(defrule initial-old-data
  (declare (salience 1))
  (not (exists (old-data-from-user)))
  =>
  (assert (old-data-from-user (primary-cloud-base unasked)
                              (primary-cloud-orientation unasked))))
                              
;**********
;Control the flow-of-execution through the program.
;**********

(deffacts control-information
(phase-sequence INPUT PRINT-INPUT FUZZIFY DETERMINE-CHANGES FORECAST PRINT-FORECAST))
  
(defrule change-phase
  ?phase-list <- (phase-sequence ?next-phase $?other-phases)
  =>
  (focus ?next-phase)
  (retract ?phase-list)
  (assert (phase-sequence ?other-phases)))
  
;************************************************************
;*                   MODULE:  INPUT                         *
;************************************************************

(defmodule INPUT (import MAIN ?ALL)
                 (export ?ALL))
                
;**********
;Rule to prompt user for the current cloud cover percentage.
;Note that we use salience factors to enforce the order in 
;which the questions are asked.
;**********

(defrule ask-current-cloud-cover
  (declare (salience 3))
  ?f <- (new-data-from-user (cloud-cover unasked))
  =>
  (bind ?allowed-values (create$ 1 2 3 4 5))
  (printout t " " crlf)
  (printout t "How would you describe the current cloud coverage?" crlf)
  (printout t "    (1) clear" crlf)
  (printout t "    (2) partly-cloudy" crlf)
  (printout t "    (3) cloudy" crlf)
  (printout t "    (4) mostly-cloudy" crlf)
  (printout t "    (5) overcast" crlf)
  (printout t ">")
  (bind ?answer (read))
  (while (not (member ?answer ?allowed-values)) do
    (printout t "Please confine your answer to one of the above choices." crlf)
    (printout t ">")
    (bind ?answer (read)))
  (if (eq ?answer 1) then (modify ?f (cloud-cover clear)))
  (if (eq ?answer 2) then (modify ?f (cloud-cover partly-cloudy)))
  (if (eq ?answer 3) then (modify ?f (cloud-cover cloudy)))
  (if (eq ?answer 4) then (modify ?f (cloud-cover mostly-cloudy)))
  (if (eq ?answer 5) then (modify ?f (cloud-cover overcast))))
  
;***********
;Rule to prompt user for the current base height of primary clouds.
;***********

(defrule ask-current-primary-cloud-base
  (declare (salience 2))
  ?f <- (new-data-from-user (cloud-cover ~clear)
                            (primary-cloud-base unasked))
  =>
  (bind ?allowed-values (create$ 1 2 3 4 5 6 7))
  (printout t " " crlf)
  (printout t "How would you describe the current primary cloud base?" crlf)
  (printout t "    (1) very, very low" crlf)
  (printout t "    (2) very low" crlf)
  (printout t "    (3) low" crlf)
  (printout t "    (4) middle" crlf)
  (printout t "    (5) high" crlf)
  (printout t "    (6) very high" crlf)
  (printout t "    (7) very, very high" crlf)
  (printout t ">")
  (bind ?answer (read))
  (while (not (member ?answer ?allowed-values)) do
    (printout t "Please confine your answer to one of the above choices." crlf)
    (printout t ">")
    (bind ?answer (read)))
  (if (eq ?answer 1) then (modify ?f (primary-cloud-base very very low)))
  (if (eq ?answer 2) then (modify ?f (primary-cloud-base very low)))
  (if (eq ?answer 3) then (modify ?f (primary-cloud-base low)))
  (if (eq ?answer 4) then (modify ?f (primary-cloud-base middle)))
  (if (eq ?answer 5) then (modify ?f (primary-cloud-base high)))
  (if (eq ?answer 6) then (modify ?f (primary-cloud-base very high)))
  (if (eq ?answer 7) then (modify ?f (primary-cloud-base very very high))))

;**********
;Rule to prompt user for the current orientation of primary clouds.
;**********

(defrule ask-current-primary-cloud-orientation
  (declare (salience 2))
  ?f <- (new-data-from-user (cloud-cover ~clear)
                            (primary-cloud-orientation unasked))
  =>
  (bind ?allowed-values (create$ 1 2 3 4 5 6 ))
  (printout t " " crlf)
  (printout t "How would you describe the current orientation of primary clouds?" crlf)
  (printout t "    (1) very, very horizontal" crlf)
  (printout t "    (2) very horizontal" crlf)
  (printout t "    (3) horizontal" crlf)
  (printout t "    (4) vertical" crlf)
  (printout t "    (5) very vertical" crlf)
  (printout t "    (6) very, very vertical" crlf)
  (printout t ">")
  (bind ?answer (read))
  (while (not (member ?answer ?allowed-values)) do
    (printout t "Please confine your answer to one of the above choices." crlf)
    (printout t ">")
    (bind ?answer (read)))
  (if (eq ?answer 1) then (modify ?f (primary-cloud-orientation very very horizontal)))
  (if (eq ?answer 2) then (modify ?f (primary-cloud-orientation very horizontal)))
  (if (eq ?answer 3) then (modify ?f (primary-cloud-orientation horizontal)))
  (if (eq ?answer 4) then (modify ?f (primary-cloud-orientation vertical)))
  (if (eq ?answer 5) then (modify ?f (primary-cloud-orientation very vertical)))
  (if (eq ?answer 6) then (modify ?f (primary-cloud-orientation very very vertical))))
  
  
;**********
;Rule to prompt user for direction of current primary clouds.
;**********

(defrule ask-current-primary-cloud-direction
  (declare (salience 2))
  ?f <- (new-data-from-user (cloud-cover ~clear)
                            (primary-clouds-moving-from unasked))
  =>
  (bind ?allowed-values (create$ 1 2 3 4 5 6 7 8 9 10))
  (printout t " " crlf)
  (printout t "Currently, from what direction are the primary clouds moving?" crlf)
  (printout t "    (1)  not-applicable" crlf)
  (printout t "    (2)  unknown" crlf)
  (printout t "    (3)  north" crlf)
  (printout t "    (4)  northeast" crlf)
  (printout t "    (5)  east" crlf)
  (printout t "    (6)  southeast" crlf)
  (printout t "    (7)  south" crlf)
  (printout t "    (8)  southwest" crlf)