CLIPS, aka C Language Integrated Production System, is a programming language created in 1985.
| #239on PLDB | 39Years Old | 2kRepos |
Try now: TIO
CLIPS is a public domain software tool for building expert systems. The name is an acronym for "C Language Integrated Production System." The syntax and name was inspired by Charles Forgy's OPS ("Official Production System," although there was nothing really official about it). The first versions of CLIPS were developed starting in 1985 at NASA-Johnson Space Center (as an alternative for existing system ART*Inference) until the mid-1990s when the development group's responsibilities ceased to focus on expert system technology. Read more on Wikipedia...
(deftemplate car_problem
(slot name)
(slot status))
(deffacts trouble_shooting
(car_problem (name ignition_key) (status on))
(car_problem (name engine) (status wont_start))
(car_problem (name headlights) (status work)))
(defrule rule1
(car_problem (name ignition_key) (status on))
(car_problem (name engine) (status wont_start))
=>
(assert (car_problem (name starter) (status faulty))))(defrule hw
(f ?x)
=>
(printout t ?x crlf))
(assert (f "Hello World"))
(run)
;;; http://www.angusj.com/sudoku/hints
;;; http://www.scanraid.com/BasicStrategies.htm
;;; http://www.sudokuoftheday.com/pages/techniques-overview
;;; http://www.sudokuonline.us/sudoku_solving_techniques
;;; http://www.sadmansoftware.com/sudoku/techniques.htm
;;; http://www.krazydad.com/blog/2005/09/29/an-index-of-sudoku-strategies/
;;; #######################
;;; DEFTEMPLATES & DEFFACTS
;;; #######################
(deftemplate possible
(slot row)
(slot column)
(slot value)
(slot group)
(slot id))
(deftemplate impossible
(slot id)
(slot value)
(slot priority)
(slot reason))
(deftemplate technique-employed
(slot reason)
(slot priority))
(deftemplate technique
(slot name)
(slot priority))
(deffacts startup
(phase grid-values))
(deftemplate size-value
(slot size)
(slot value))
(deffacts values
(size-value (size 1) (value 1))
(size-value (size 2) (value 2))
(size-value (size 2) (value 3))
(size-value (size 2) (value 4))
(size-value (size 3) (value 5))
(size-value (size 3) (value 6))
(size-value (size 3) (value 7))
(size-value (size 3) (value 8))
(size-value (size 3) (value 9))
(size-value (size 4) (value 10))
(size-value (size 4) (value 11))
(size-value (size 4) (value 12))
(size-value (size 4) (value 13))
(size-value (size 4) (value 14))
(size-value (size 4) (value 15))
(size-value (size 4) (value 16))
(size-value (size 5) (value 17))
(size-value (size 5) (value 18))
(size-value (size 5) (value 19))
(size-value (size 5) (value 20))
(size-value (size 5) (value 21))
(size-value (size 5) (value 22))
(size-value (size 5) (value 23))
(size-value (size 5) (value 24))
(size-value (size 5) (value 25)))
;;; ###########
;;; SETUP RULES
;;; ###########
;;; ***********
;;; stress-test
;;; ***********
(defrule stress-test
(declare (salience 10))
(phase match)
(stress-test)
(priority ?last)
(not (priority ?p&:(> ?p ?last)))
(technique (priority ?next&:(> ?next ?last)))
(not (technique (priority ?p&:(> ?p ?last)&:(< ?p ?next))))
=>
(assert (priority ?next)))
;;; *****************
;;; enable-techniques
;;; *****************
(defrule enable-techniques
(declare (salience 10))
(phase match)
(size ?)
(not (possible (value any)))
=>
(assert (priority 1)))
;;; **********
;;; expand-any
;;; **********
(defrule expand-any
(declare (salience 10))
(phase expand-any)
?f <- (possible (row ?r) (column ?c) (value any) (group ?g) (id ?id))
(not (possible (value any) (id ?id2&:(< ?id2 ?id))))
(size ?s)
(size-value (size ?as&:(<= ?as ?s)) (value ?v))
(not (possible (row ?r) (column ?c) (value ?v)))
(not (and (size-value (value ?v2&:(< ?v2 ?v)))
(not (possible (row ?r) (column ?c) (value ?v2)))))
=>
(assert (possible (row ?r) (column ?c) (value ?v) (group ?g) (id ?id))))
;;; *****************
;;; position-expanded
;;; *****************
(defrule position-expanded
(declare (salience 10))
(phase expand-any)
?f <- (possible (row ?r) (column ?c) (value any) (group ?g) (id ?id))
(size ?s)
(not (and (size-value (size ?as&:(<= ?as ?s)) (value ?v))
(not (possible (row ?r) (column ?c) (value ?v)))))
=>
(retract ?f))
;;; ###########
;;; PHASE RULES
;;; ###########
;;; ***************
;;; expand-any-done
;;; ***************
(defrule expand-any-done
(declare (salience 10))
?f <- (phase expand-any)
(not (possible (value any)))
=>
(retract ?f)
(assert (phase initial-output))
(assert (print-position 1 1)))
;;; ***********
;;; begin-match
;;; ***********
(defrule begin-match
(declare (salience -20))
?f <- (phase initial-output)
=>
(retract ?f)
(assert (phase match)))
;;; *****************
;;; begin-elimination
;;; *****************
(defrule begin-elimination
(declare (salience -20))
?f <- (phase match)
(not (not (impossible)))
=>
(retract ?f)
(assert (phase elimination)))
;;; *************
;;; next-priority
;;; *************
(defrule next-priority
(declare (salience -20))
(phase match)
(not (impossible))
(priority ?last)
(not (priority ?p&:(> ?p ?last)))
(technique (priority ?next&:(> ?next ?last)))
(not (technique (priority ?p&:(> ?p ?last)&:(< ?p ?next))))
=>
(assert (priority ?next)))
;;; ************
;;; begin-output
;;; ************
(defrule begin-output
(declare (salience -20))
?f <- (phase match)
(not (impossible))
(priority ?last)
(not (priority ?p&:(> ?p ?last)))
(not (technique (priority ?next&:(> ?next ?last))))
=>
(retract ?f)
(assert (phase final-output))
(assert (print-position 1 1)))
(deftemplate car_problem
(slot name)
(slot status))
(deffacts trouble_shooting
(car_problem (name ignition_key) (status on))
(car_problem (name engine) (status wont_start))
(car_problem (name headlights) (status work)))
(defrule rule1
(car_problem (name ignition_key) (status on))
(car_problem (name engine) (status wont_start))
=>
(assert (car_problem (name starter) (status faulty))))| Feature | Supported | Token | Example |
|---|---|---|---|
| Strings | ✓ | " | "Hello world" |
| Comments | ✓ | ; A comment |
|
| Line Comments | ✓ | ; | ; A comment |
| Semantic Indentation | X |