Tag: clips

; Diagnoser | Expert System task 4cs

;
; run:
; CLIPS> (load C:\PATH_DIR\main.clp)
; CLIPS> (run)


(deffunction print-parts()
	(printout t crlf "--= Diagnoser =--" crlf crlf)
	(printout t "> eye (available)" crlf)
	(printout t "> nose (available)" crlf)
	(printout t "> ear" crlf)
	(printout t "> mouth" crlf)
	(printout t "> shoulder" crlf)
	(printout t "> neck" crlf)
	(printout t "> hand" crlf)
	(printout t "> arm" crlf)
	(printout t "> elbow" crlf)
	(printout t "> waist" crlf)
	(printout t "> stomack" crlf)
	(printout t "> leg" crlf)
	(printout t "> foot" crlf)
	(printout t "Choose part: ")
)

(defglobal  ?*sum* = 0)

; vvvvvvvvvvvvvvvvvv
(defrule START_POINT
	?f <- (initial-fact)
=>
	(load-facts "kb.clp")
	(retract ?f)
	(print-parts)
	(assert (ask-part (read)))
)

(defrule ask-part
	?f <- (ask-part ?part)
	(ask-part ?)
=>
	(printout t "-->> " ?part ":" crlf)
	(assert (ask-questions ?part))
)

(defrule ask-questions
	?f <- (ask-questions ?part)
	?f2 <- (question ?part ?perc $?text)
	(ask-questions ?)
=>
	(printout t $?text " [yes, no] ")
	(bind ?ans (read))
	(if (member$ ?ans (create$ yes) )
		then (bind ?*sum* (+ ?*sum* ?perc))
	)
	(assert (result ?part))
)

(defrule result
	?f <- (result ?part)
	(advice ?part $?text)
	(result ?)
=>
	(retract ?f)
	(if (> ?*sum* 0)
		then 
			(printout t crlf "danger percentage: " ?*sum* "%" crlf)
			(printout t $?text crlf crlf)
		else 
			(printout t crlf "you are ok!" crlf crlf)
	)
)

; Diagnoser | Knowledge base
;
; Expert person(ex. doctor) will add symptoms here


(question nose 50 Is there nose runny?)
(question nose 20 Is there sneezing?)
(question nose 30 is there sore throat?)
; برد - دكتور انف واذن
(advice nose Maybe it's cold go to otolaryngologist doctor)


(question eye 40 Is there friction in the eye?)
(question eye 40 Is eyes are red?)
(question eye 20 Are there tears?)
; التهاب فى العين- دكتور عيون
(advice eye Maybe it's Inflammation go to ophthalmologist doctor)

 

;; @Author       Khaled
;; @Subject      4_CS_AI
;; @Proj. Desc.  {Smart Parking System} 
;;				    - Organize parking process intelligently.
;;					- Suggest nearest free position.
;;
;; @Lang.        CLIPS, BASH
;; @Env.         GUI v6.3 win | CLI v6.24 debian
;; @File         @Name "app.clp" | @Created 19-nov-2018
;; @Performance  Greedy algo. | linear O(N) | N ~= positions 
;; 
;; _________________run info___________________________
;; CLIPS> (clear) 
;; CLIPS> (load C:\Users\YOUR_PATH_DIR\app.clp)
;; CLIPS> (run)
;;###########################################################



;; ~~~~  START STYLE FUNCTIONS  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(deffunction print-lines (?howMany)
	(while (> ?howMany 0) do (printout t crlf) (bind ?howMany (- ?howMany 1)))
)

(deffunction print-spaces (?howMany)
	(while (> ?howMany 0) do (printout t " ") (bind ?howMany (- ?howMany 1)))
)
;; ~~~~  END STYLE FUNCTIONS  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~





;; ~~~~  START GLOBAL VARS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defglobal 
	?*booked*  		   = (create$ )
	?*enterAnswers*    = (create$ 1 e enter)
	?*leaveAnswers*    = (create$ 2 l leave)
	?*welcomeAnswers*  = (create$ ?*enterAnswers* ?*leaveAnswers*)
	?*exitAnswers*     = (create$ exit end out pause halt -1 3)
)
;; ~~~~  END GLOBAL VARS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~




;; ~~~~  START MY CORE FUNCTIONS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;; Constant O(1)
(deffunction wait-any-key()
	(printout t "press any key to continue! ")
	(bind ?wait (read))
)


;; Constant O(1)
(deffunction is-valid-position(?pos)
	(return (and (>= ?pos 1) (<= ?pos 20)))
)

;; Linear O(N)
(deffunction removeBooked (?pos)
	(bind ?start 1)
	(bind ?end 20)
	(bind ?tmpBooked (create$))
	(while (<= ?start ?end)
		(if (and (<> ?start ?pos) (member$ ?start ?*booked*))
			then
				(bind ?tmpBooked (insert$ ?tmpBooked 1 ?start))
		)
		(bind ?start (+ ?start 1))
	)
	(bind ?*booked* ?tmpBooked)
	(return 0)
)

;; Constant O(1)
(deffunction getDistanceOfIndex(?idx)

	;; Positions 2 Lines:
	;;  GA  [1  : 10]
	;;  TE  [20 : 11]
	
	;; Algorithm Pseudocode:-
	;;''''''''''''''''''''''
	;; if     distance <= 10  =:  distance_to_gate = idx[1:10]
	;; elseif distance <= 20  =:  distance_to_gate = 20 - idx[11:20] + 1
	
	(if (and (>= ?idx 1) (<= ?idx 10))
		then
			(return ?idx)
		else
			(if (and (>= ?idx 11) (<= ?idx 20))
				then
					(return (+ (- 20 ?idx) 1))
			)
	)
	(return -1)
)


;; Linear O(N)
(deffunction getNearestEmptyPosition ()
	(bind ?start 1)
	(bind ?end 20)
	(bind ?bestIdx 1)
	(bind ?mi 11)  ;; max possible is 10
	
	(while (<= ?start ?end)
		(if (not (member$ ?start ?*booked*))
			then
				(bind ?disOfIdx  (getDistanceOfIndex ?start))
				(if (< ?disOfIdx ?mi)
					then
						(bind ?mi ?disOfIdx)
						(bind ?bestIdx ?start)
				)
		)
		(bind ?start (+ ?start 1))
	)
	(return ?bestIdx)
)


;; ~~~~  START MY CORE FUNCTIONS  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~




;; ~~~~  START MESSAGES  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(deffunction message-welcome()
	(print-lines 25) (print-spaces 20)
	(printout t "--=  Smart Parking System using CLIPS (AI)Project  =--")
	(print-lines 2)(print-spaces 30)(printout t "Organize parking process intelligently!")
	(print-lines 20) (printout t "Choose:") (print-lines 1)
	(printout t "1- Enter (1, e, E, Enter)")     (print-lines 1)
	(printout t "2- Leave (2, l, L, Leave)")     (print-lines 1)
	(printout t "3- Exit  (3, -1, exit, end, halt, out, pause)") (print-lines 2)(printout t "? ")
)

(deffunction message-select-position()
	(print-lines 25) (print-spaces 20)
	(printout t "There are 20 positions (2 lines)") (print-lines 3)
	(printout t "  Enter  |\\_   1  2   3   4   5   6   7   8   9  10")(print-lines 1)
	(printout t "  GATE   |/   20 19  18  17  16  15  14  13  12  11")(print-lines 2)
	(print-lines 5)
)

(deffunction message-leave-position()
	(print-lines 5) (printout t "What was your position? ")
)

(deffunction message-all-busy()
	(print-lines 5)(printout t "Sorry all positions are busy!")(print-lines 5)
)

(deffunction message-booked-position()
	(print-lines 5)(printout t "Sorry you entered booked position!")(print-lines 5)
)

(deffunction message-wrong-position()
	(print-lines 5)(printout t "Sorry you entered wrong position! (correct [1 : 20])")
	(print-lines 5)
)

(deffunction message-selected-position-empty()
	(print-lines 5)(printout t "Sorry selected position is already empty!")
	(print-lines 5)
)

(deffunction message-enter-ok(?pos)
	(print-lines 5)(printout t "Welcome ^_*")(print-lines 5)
	(printout t "Use position [" ?pos "] please!" )(print-lines 5)
)


(deffunction message-best-nearest(?pos)
	(print-lines 5)(printout t "[note] nearest empty position to gate is " ?pos)
	(print-lines 5)
)

(deffunction message-leave-ok()
	(print-lines 5)
	(printout t "Thank you *_^ for using our parking service, see you soon!")
	(print-lines 5)
)

;; ~~~~  END MESSAGES  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~






;; ~~~~ START POINT ~~~~
(defrule MAIN::__COOL_CPU__

	?f <- (initial-fact)
=>
	(retract ?f)
	(message-welcome)
	(bind ?input (read))
	
	;; Normalize the input
	(if (lexemep ?input) then (bind ?input (lowcase ?input)))  
	
	(if (or (member$ ?input ?*enterAnswers*)
			(member$ ?input ?*leaveAnswers*)
		)
		then
			(assert (ask-position))
	)
	(assert (answer-welcome ?input))
)



(defrule MAIN::ASKER-POSITION
	?f <- (ask-position)
	(answer-welcome ?ans)
=>
	(if (member$ ?ans ?*enterAnswers*)
		then
			(message-select-position)
			(message-best-nearest (getNearestEmptyPosition))
			(printout t "Choose? ")
			(assert (booking-now))
		else
			(message-leave-position)
			(assert (leave-now))
	)
	
	(assert (answer-position (read)))
	(retract ?f)
)




(defrule MAIN::BOOK
	?f <- (booking-now)
	?x <- (answer-welcome  ?welcome)
	(test (member$ ?welcome ?*enterAnswers*))
	?p <- (answer-position ?pos)
=>
	(if (and (is-valid-position ?pos) (not (member$ ?pos ?*booked*)))
		then
			(bind ?*booked* (insert$ ?*booked* 1 ?pos))
			(message-enter-ok ?pos)
		else
			(if (>= (length ?*booked*) 20)
				then
					(message-all-busy)
				else
					(if (not (is-valid-position ?pos))
						then
							(message-wrong-position)
						else
							(message-booked-position)
					)
			)
	)
	(wait-any-key)
	(retract ?f)
	(retract ?p)
	(retract ?x)
	(assert (initial-fact))
)


(defrule MAIN::LEAVE
	?f <- (leave-now)
	?x <- (answer-welcome  ?welcome)
	(test (member$ ?welcome ?*leaveAnswers*))
	?p <- (answer-position ?pos)
=>
	(if (member$ ?pos ?*booked*)
		then
			(removeBooked ?pos)
			(message-leave-ok)
		else
			(if (not (is-valid-position ?pos))
				then
					(message-wrong-position)
				else
					(message-selected-position-empty)
			)
	)
	(wait-any-key)
	(retract ?f)
	(retract ?x)
	(retract ?p)
	(assert (initial-fact))
)



 
(defrule MAIN::APP-WINDOW
	?f <- (answer-welcome ?ans)
	(test (not (member$ ?ans ?*exitAnswers*)))
=>
	(retract ?f)
	(assert (initial-fact))
)
 
(reset)
 
(run)
 
(exit)