;;;--------------------------------------------------------------------------
;;;		Fuzzy Econo-Dynamics - N Firme, Comp/Max-Strategy - v4
;;;--------------------------------------------------------------------------
;;;
;;;     Implementeaza un sistem economic format din doua sau mai multe 
;;; firme concurente ce isi modifica pretul de vanzare al produsului 
;;; functie de beneficiu si pretul concurentei (Strategia Comp) sau 
;;; numai in functie de pretul concurentei (Strategia Max).
;;;__________________________________________________________________________
;;;
;;;      Beneficiul depinde neliniar de pret: la pret prea scazut, acesta 
;;; scade (diferenta pret-cheltuieli mica sau negativa). De asemenea, la 
;;; pret prea mare, beneficiul scade - in primul rand daca concurenta are 
;;; un pret mai mic, dar chiar si la preturi egale, dar mari, deoarece sunt 
;;; mai putini cumparatori pe piata.
;;;
;;;      Dinamica apare deoarece modificarea pretului (care este reactia 
;;; firmei, politica firmei fata de beneficiul avut la momentul respectiv) 
;;; este lenta (cu intarziere). De asemenea, concurenta raspunde cu intarziere
;;; la reactia firmei.
;;;__________________________________________________________________________
;;;
;;;     Fisierul cu datele de intrare "Ec_dyn.in" trebuie sa contina pentru 
;;; toate cele N firme numele acestora, pretul initial al produsului, precum 
;;; si strategia pe care aceasta o foloseste. Pentru strategie se pot folosi
;;; simbolurile 'comp' si 'max' (implicit se foloseste 'comp'). Dupa introducerea 
;;; acestor date se va specifica si matricea M cu intarzierile reactiilor firmelor.
;;; 	Programul creaza fisierul "Ec_dyn.out" cu datele de iesire, preturile
;;; si profiturile celor N firme, pentru prelucrari statistice ulterioare.

;* V9->V10 Optiune suplimentara de fluctuatie a pretului (valoarea poate ramane aceiasi),
;*         optiune absolut necesara pentru stabilitatea sistemului (in absenta acesteia 
;*         sistemul economic nu poate atinge niciodata un punct de echilibru)

;* V10->V11 Sunt introduse mai multe firme pe piata (nu doar doua ca in modelul initial)
;*          Intarzierile cu care o firma afla preturile celorlalte firme sunt citite 
;*          dintr-un fisier text sub forma unei matrici

;* V11->NV1 Fluctuatia pretului nu mai este realizata doar cu prag fix (variabil in 
;*          variante anterioare), ci poate fi calculata si fuzzy. Tipul de increment este 
;*          acelasi pentru toate firmele de pe piata

;* NV2 - s-a adaugat o noua strategie max-benefit (de maximizare a profitului)

;* NV3 - posibilitatea asocierii pentru fiecare firma a unui tip de increment (fuzzy/fix)

;* NV4 - posibilitatea gruparii firmelor pe tipuri de functii de apartenenta
;*    - s-au definit 2 seturi de functii de apartenenta pentru pret, respectiv beneficiu
;*    - introducerea datelor despre o firma in fisierul "Ec_dyn.in" va respecta formatul
;*     nume_firma     pret_initial     strategie(max/comp)     tip_fa(1/2...)
;*          ... tip_incr(fix/fuzzy)    val_incr (daca este fix)

;* Implicit: - tip increment = fuzzy; valoare implicita increment fix = 0.1
;*	     - tip functii de apartenenta = 1
;*	     - tip strategie = comp

;============================================================================
;		     CONSTRUCTII GENERALE
;============================================================================

(defmethod + (?a)
      (return ?a)
)

(deftemplate pret1 	; preturile au aceeasi structura pentru ambele firme
      1. 25. USD
      ((scazut  ( 3 1) (10 0))
       (mediu   ( 5 0) (8 1) (21 0))  ; suprapunere ne-perfecta cu urmatoarea f.a.
       (ridicat (10 0) (25 1)))
)
(deftemplate beneficiu1  ; firmele considerate de acceeasi pondere, 
			 ; deci beneficiile cu aceeasi structura
      -25. 65. USD
      ((foarte_scazut  (-25 1) (25 0))
       (scazut         (15 0) (25 1) (35 0))
       (mediu          (25 0) (43 1) (45 0))
       (ridicat        (35 0) (55 1) (60 0))
       (foarte_ridicat (45 0) (65 1)))
)
(deftemplate pret2 	; preturile au aceeasi structura pentru ambele firme
      1. 25. USD
      ((scazut  ( 5 1) (10 0))
       (mediu   ( 5 0) (10 1) (15 0))
       (ridicat (10 0) (15 1)))
)
(deftemplate beneficiu2  ; firmele considerate de acceeasi pondere, 
			; deci beneficiile cu aceeasi structura
      -25. 65. USD
      ((foarte_scazut  (-25 1) (25 0))
       (scazut         (15 0) (25 1) (35 0))
       (mediu          (25 0) (35 1) (45 0))
       (ridicat        (35 0) (45 1) (55 0))
       (foarte_ridicat (45 0) (65 1)))
)
(deftemplate informatii1
      (slot id)
      (slot pret (type FUZZY-VALUE pret1))
)
(deftemplate informatii2
      (slot id)
      (slot pret (type FUZZY-VALUE pret2))
)
(deftemplate firma 
      (slot nume) (multislot lista_preturi) 
      (slot strategie) (slot tip_fa) (slot tip_incr) (slot val_incr) 
      (multislot firme_concurente) (slot nfc)
)
(defglobal ?*step*  = 0	  ; variabila ce contorizeaza numarul de pasi
)

;============================================================================
;
;		REGULI FUZZY DE CALCUL BENEFICIU
;
;============================================================================

(defrule beneficiu_pret_firma_scazut_pret_concurenta_scazut
      (calcul_beneficiu ? ?f1 ?f2)
      (or (informatii1 (id ?f1) (pret scazut))      ; firma #1 are pret scazut
          (informatii2 (id ?f1) (pret scazut)) )
      (or (informatii1 (id ?f2) (pret scazut))      ; firma #2 are pret scazut  
          (informatii2 (id ?f2) (pret scazut)) )
      (firma (nume ?f1) (tip_fa ?fa))
      =>
      (assert-string (str-cat "(beneficiu" ?fa " mediu)"))
)
(defrule beneficiu_pret_firma_scazut_pret_concurenta_mediu
      (calcul_beneficiu ? ?f1 ?f2)
      (or (informatii1 (id ?f1) (pret scazut))
          (informatii2 (id ?f1) (pret scazut)) )
      (or (informatii1 (id ?f2) (pret mediu))
          (informatii2 (id ?f2) (pret mediu)) )
      (firma (nume ?f1) (tip_fa ?fa))
      =>
      (assert-string (str-cat "(beneficiu" ?fa " more-or-less mediu)"))
)
(defrule beneficiu_pret_firma_scazut_pret_concurenta_ridicat
      (calcul_beneficiu ? ?f1 ?f2)
      (or (informatii1 (id ?f1) (pret scazut))
          (informatii2 (id ?f1) (pret scazut)) )
      (or (informatii1 (id ?f2) (pret ridicat))
          (informatii2 (id ?f2) (pret ridicat)) )
      (firma (nume ?f1) (tip_fa ?fa))
      =>
      (assert-string (str-cat "(beneficiu" ?fa " foarte_ridicat)"))
)
(defrule beneficiu_pret_firma_mediu_pret_concurenta_scazut
      (calcul_beneficiu ? ?f1 ?f2)
      (or (informatii1 (id ?f1) (pret mediu))
          (informatii2 (id ?f1) (pret mediu)) )
      (or (informatii1 (id ?f2) (pret scazut))
          (informatii2 (id ?f2) (pret scazut)) )
      (firma (nume ?f1) (tip_fa ?fa))
      =>
      (assert-string (str-cat "(beneficiu" ?fa " scazut)"))
)
(defrule beneficiu_pret_firma_mediu_pret_concurenta_mediu
      (calcul_beneficiu ? ?f1 ?f2)
      (or (informatii1 (id ?f1) (pret mediu))
          (informatii2 (id ?f1) (pret mediu)) )
      (or (informatii1 (id ?f2) (pret mediu))
          (informatii2 (id ?f2) (pret mediu)) )
      (firma (nume ?f1) (tip_fa ?fa))
      =>
      (assert-string (str-cat "(beneficiu" ?fa " ridicat)"))
)
(defrule beneficiu_pret_firma_mediu_pret_concurenta_ridicat
      (calcul_beneficiu ? ?f1 ?f2)
      (or (informatii1 (id ?f1) (pret mediu))
          (informatii2 (id ?f1) (pret mediu)) )
      (or (informatii1 (id ?f2) (pret ridicat))
          (informatii2 (id ?f2) (pret ridicat)) )
      (firma (nume ?f1) (tip_fa ?fa))
      =>
      (assert-string (str-cat "(beneficiu" ?fa " somewhat ridicat)"))
)
(defrule beneficiu_pret_firma_ridicat_pret_concurenta_scazut
      (calcul_beneficiu ? ?f1 ?f2)
      (or (informatii1 (id ?f1) (pret ridicat))
          (informatii2 (id ?f1) (pret ridicat)) )
      (or (informatii1 (id ?f2) (pret scazut))
          (informatii2 (id ?f2) (pret scazut)) )
      (firma (nume ?f1) (tip_fa ?fa))
      =>
      (assert-string (str-cat "(beneficiu" ?fa " foarte_scazut)"))
)
(defrule beneficiu_pret_firma_ridicat_pret_concurenta_mediu
      (calcul_beneficiu ? ?f1 ?f2)
      (or (informatii1 (id ?f1) (pret ridicat))
          (informatii2 (id ?f1) (pret ridicat)) )
      (or (informatii1 (id ?f2) (pret mediu))
          (informatii2 (id ?f2) (pret mediu)) )
      (firma (nume ?f1) (tip_fa ?fa))
      =>
      (assert-string (str-cat "(beneficiu" ?fa " scazut)"))
)
(defrule beneficiu_pret_firma_ridicat_pret_concurenta_ridicat
      (calcul_beneficiu ? ?f1 ?f2)
      (or (informatii1 (id ?f1) (pret ridicat))
          (informatii2 (id ?f1) (pret ridicat)) )
      (or (informatii1 (id ?f2) (pret ridicat))
          (informatii2 (id ?f2) (pret ridicat)) )
      (firma (nume ?f1) (tip_fa ?fa))
      =>
      (assert-string (str-cat "(beneficiu" ?fa " scazut)"))
)

;============================================================================
;
;		REGULI FUZIFICARE / DEFUZIFICARE
;
;============================================================================

; Regulile de calcul al beneficiului la un pret actual si la pret intarziat
; se vor activa de maxim n*(n-1) ori deorece variabila ?id1 va fi inlocuita 
; pe rand cu unul din simbolurile din lista numelor firmelor, iar variabila 
; ?id2 va fi una din firmele concurente

(defrule startare_calcul_beneficiu_la_pret_actual
      (declare (salience -2))
      (not (valoare_pret ? scade|creste|aceiasi|stop )) ; daca modificarea preturilor s-a efectuat
      (firma (nume ?id1) (tip_fa ?fa1) (strategie ?str) ; se selecteaza firma curenta ?id1
             (firme_concurente $? ?id2 $?)              ; si una din firmele concurente ?id2
             (lista_preturi ?vpaf $?))                  ; pretul actual al firmei ?vpaf
      (firma (nume ?id2) (tip_fa ?fa2)
             (lista_preturi $?l ?vpic $?))              ; pretul intarziat al concurentei ?vpic
      (intarziere ?id1 ?id2 ?tau)
      (test (eq (length$ $?l) ?tau))
      =>
      (assert (calcul_beneficiu pret_actual ?id1 ?id2))
      (assert-string (str-cat "(informatii" ?fa1 " (id " ?id1") (pret (PI 0 " ?vpaf ")))"))
      (assert-string (str-cat "(informatii" ?fa2 " (id " ?id2") (pret (PI 0 " ?vpic ")))"))
      (if (neq ?str max-profit) then
         (assert (adauga_pret_concurenta ?id1 ?vpic)) )
)

(defrule startare_calcul_beneficiu_la_pret_intarziat
      (declare (salience -2))
      (not (valoare_pret ? scade|creste|aceiasi|stop )) ; daca modificarea preturilor s-a efectuat
      (firma (nume ?id1) (tip_fa ?fa1) (strategie ?str) ; se selecteaza firma curenta ?id1
             (firme_concurente $? ?id2 $?)              ; si una din firmele concurente ?id2
             (lista_preturi $?l ?vpif $?))              ; pretul intarziat al firmei ?vpif
      (firma (nume ?id2) (tip_fa ?fa2)
             (lista_preturi ?vpac $?))                  ; pretul actual al concurentei ?vpac
      (or (firma (nume ?id2) (strategie max-profit) (tip_incr fuzzy))
	  (firma (nume ?id2) (strategie comp-profit)) )
      (intarziere ?id2 ?id1 ?tau)
      (test (eq (length$ $?l) ?tau))
      =>
      (assert (calcul_beneficiu pret_intarziat ?id1 ?id2))
      (assert-string (str-cat "(informatii" ?fa1 " (id " ?id1 ") (pret (PI 0 " ?vpif ")))"))
      (assert-string (str-cat "(informatii" ?fa2 " (id " ?id2 ") (pret (PI 0 " ?vpac ")))"))
)

(defrule startare_evaluare_beneficiu_pret_mai_ridicat
      (declare (salience -2))
      (or (evaluare_beneficiu ?id1) 
          (firma (nume ?id1) (strategie max-profit)) )
      (not (valoare_pret ? scade|creste|aceiasi)) 
      (firma (nume ?id1) (tip_fa ?fa1) (lista_preturi ?vp1 $?))
      (firma (nume ?id2) (tip_fa ?fa2) (lista_preturi $?l ?vp2 $?))
      (intarziere ?id1 ?id2 ?tau)
      (test (eq (length$ $?l) ?tau))  ;;;(and ... (< ?vp1 (get-u-to pret)) )
      (or (and (firma (nume ?id1) (tip_incr fuzzy)) (valoare_increment ?id1 ?incr) )
	  (firma (nume ?id1) (tip_incr fix) (val_incr ?incr)) )
      =>
      (if (> (bind ?vp1_next (+ ?vp1 ?incr)) (get-u-to (sym-cat pret ?fa1)) ) then 
         (bind ?vp1_next (get-u-to (sym-cat pret ?fa1)) ))
      (assert-string (str-cat "(informatii" ?fa1 " (id " ?id1 ") (pret (PI 0 " ?vp1_next ")))"))
      (assert-string (str-cat "(informatii" ?fa2 " (id " ?id2 ") (pret (PI 0 " ?vp2 ")))"))
      (assert (calcul_beneficiu pret_mai_ridicat ?id1 ?id2) )
)

(defrule startare_evaluare_beneficiu_pret_mai_scazut
      (declare (salience -2))
      (or (evaluare_beneficiu ?id1) 
          (firma (nume ?id1) (strategie max-profit)) )
      (not (valoare_pret ? scade|creste|aceiasi))
      (firma (nume ?id1) (tip_fa ?fa1) (lista_preturi ?vp1 $?))
      (firma (nume ?id2) (tip_fa ?fa2) (lista_preturi $?l ?vp2 $?))
      (intarziere ?id1 ?id2 ?tau)
      (test (eq (length$ $?l) ?tau))  ;;;(and ... (> ?vp1 (get-u-from pret)) )
      (or (and (firma (nume ?id1) (tip_incr fuzzy)) (valoare_increment ?id1 ?incr) )
	  (firma (nume ?id1) (tip_incr fix) (val_incr ?incr)) )
      =>
      (if (< (bind ?vp1_next (- ?vp1 ?incr)) (get-u-from (sym-cat pret ?fa1)) ) then
         (bind ?vp1_next (get-u-from (sym-cat pret ?fa1)) ))
      (assert-string (str-cat "(informatii" ?fa1 " (id " ?id1 ") (pret (PI 0 " ?vp1_next ")))"))
      (assert-string (str-cat "(informatii" ?fa2 " (id " ?id2 ") (pret (PI 0 " ?vp2 ")))"))
      (assert (calcul_beneficiu pret_mai_scazut ?id1 ?id2) )
)

; Defuzificarea poate fi realizata prin doua metode COG si MAXIMUM
; functie de functia utilizata moment-defuzzify sau maximum-defuzzify

(defrule calcul_valori_crisp_beneficiu      
	(declare (salience -1))
	?d <- (calcul_beneficiu ?tip ?id1 ?id2)	; ?d = adresa fapt decizie
	(or ?b <- (beneficiu1 ?)		; ?b = adresa fapt beneficiu
            ?b <- (beneficiu2 ?))
	(or ?i1 <- (informatii1 (id ?id1))	; se sterg informatiile ce au servit la
            ?i1 <- (informatii2 (id ?id1)) )    ; calcularea beneficiului
	(or ?i2 <- (informatii1 (id ?id2))
            ?i2 <- (informatii2 (id ?id2)) )
	=>
	(retract ?d ?b ?i1 ?i2)
	(assert (valoare_beneficiu ?tip ?id1 ?id2 (moment-defuzzify ?b)))
;	(assert (valoare_beneficiu ?tip ?id1 ?id2 (maximum-defuzzify ?b)))
)

;============================================================================
;
;		REGULI CITIRE / SCRIERE IN FISIER
;	     REGULA DE INITIALIZARE LISTE DE PRETURI
;
;============================================================================

(defrule open_file                    ; result file 
      (declare (salience 20))         ; max salience 20
      =>
      (open "Ec_dyn.in" in "r")
      (bind $?lista (create$ ))
      (bind ?error 0) (bind ?nr_firme 0)
      (while (neq (bind ?line (readline in)) EOF) do
         (bind ?line (explode$ ?line))
	 (if (> (length$ ?line) 0) then
            (if (eq ?nr_firme 0) then	; nu s-au citit toate firmele
               (bind ?nume_firma (nth$ 1 ?line))
               (bind ?pret_initial (nth$ 2 ?line))
	       (bind ?strategie (nth$ 3 ?line))
               (bind ?tip_fa (nth$ 4 ?line))
               (bind ?tip_incr (nth$ 5 ?line))
               (if (not (numberp ?nume_firma)) then
                  (if (or (not (symbolp ?tip_incr)) (neq (lowcase ?tip_incr) fix)) then
                     (bind ?tip_incr fuzzy)             ; tip implicit increment = fuzzy
                     (bind ?val_incr fuzzy)             ; va trebui sa fie calculata
                   else
                     (bind ?val_incr (nth$ 6 ?line))
                     (if (not (numberp ?val_incr)) then ; valoare implicita increment fix = 0.1
                        (bind ?val_incr 0.1)
                  )  )
                  (if (not (numberp ?tip_fa)) then
                     (bind ?tip_fa 1) )                   ;tip implicit functii de apartenenta = 1
                  (if (or (not (symbolp ?strategie)) (neq (lowcase ?strategie) comp max)) then 
                     (bind ?strategie comp) )			    ; tip implicit strategie = comp
                  (if (numberp ?pret_initial) then
                     (bind $?lista (create$ $?lista ?nume_firma))
                     (bind ?strategie (sym-cat (lowcase ?strategie) -profit))
                     (assert (firma (nume ?nume_firma) (strategie ?strategie) (tip_fa ?tip_fa) 
                                    (tip_incr ?tip_incr) (val_incr ?val_incr))
                             (pret_initial ?nume_firma ?pret_initial) )
                   else (bind ?error 1) (break) )
                else
                  (bind ?nr_firme (length$ $?lista))
                  (bind ?firma_curenta 1)
                  (if (< ?nr_firme 2) then (bind ?error 2) (break) ) 
            )  )
            (if (neq ?nr_firme 0) then
               (bind $?firme_concurente (create$ )) 
               (loop-for-count (?i 1 ?nr_firme) do
                  (if (or (numberp (bind ?v (nth$ ?i ?line))) (eq ?v -)) then
                     (if (neq ?firma_curenta ?i) then
                        (if (neq ?v -) then
                           (assert (intarziere (nth$ ?firma_curenta ?lista) (nth$ ?i ?lista) ?v))
                           (bind $?firme_concurente (create$ $?firme_concurente (nth$ ?i ?lista))) )
                      else (assert (preturi_concurenta (nth$ ?firma_curenta ?lista))) )
                   else (bind ?error 3) (break) )
               )
               (if (neq ?error 3) then
                  (assert (firme_concurente (nth$ ?firma_curenta ?lista) $?firme_concurente) )
                  (bind ?firma_curenta (+ ?firma_curenta 1))
                else
                  (break) )
      )  )  )
      (printout t "Fisierul de intrare \"Ec_dyn.in\" ")
      (switch ?error
         (case 1 then (printout t "are preturile initiale eronate." t))
	 (case 2 then (printout t "are un numarul de firme prea mic." t))
	 (case 3 then (printout t "are intarzierile reactiilor firmelor incorecte." t))
	 (default (printout t "a fost citit cu succes." t)
            (assert (lista_firme ?lista)) ) 
      )
      (close in)

      (open "Ec_dyn.out" d "w")
      (printout t crlf "Datele de iesire se afla in fisierul \"Ec_dyn.out\"" t t)
;      (format d "      Pret vs Beneficiu %n %n")
;      (format d "     P1 vs B1   ||   P2 vs B2 %n %n")

;      (printout t "Introduceti numarul maxim de pasi de calcul(implicit " ?*step* "): " t)
;      (bind ?n (read))
;      (if (numberp ?n) then (bind ?*step* (abs (integer ?n))) )
)

(defrule completare_valori_lista_preturi
      (declare (salience 10))
      ?f1 <- (firma (nume ?nume_firma))
      ?f2 <- (firme_concurente ?nume_firma $?fc)
      (intarziere ? ?nume_firma ?v)
      (not (exists (intarziere ? ?nume_firma ?v2 &:(> ?v2 ?v)) ))
      ?f3 <- (pret_initial ?nume_firma ?vp)
      =>
      (retract ?f2 ?f3) 
      (bind $?lista (create$ ?vp))
      (loop-for-count (?i 1 ?v) do
         (bind $?lista (create$ $?lista ?vp))
      )
      (modify ?f1 (firme_concurente $?fc) (nfc (length$ $?fc)) (lista_preturi $?lista))
)

(defrule afisare_informatii_1
      (declare (salience -10))
      (lista_firme ?id $?last)
      (firma (nume ?id) (lista_preturi ?vpf $?))	; vpf - valoare curenta pret firma
      ?f <- (beneficiu_mediu pret_actual ?id ?vbf)
      =>
      (retract ?f)
      (format d "%3d    %4.2f    %6.3f" ?*step* ?vpf ?vbf)
;      (format t "%3d   %3.1f -- %6.3f" ?*step* ?vpf ?vbf)
      (bind ?*step* (+ ?*step* 1))
      (assert (lista_firme_de_afisat $?last))
)
	
(defrule afisare_informatii_2
      ?f1 <- (lista_firme_de_afisat ?id $?last)
      (firma (nume ?id) (lista_preturi ?vpf $?))	; vpf - valoare curenta pret firma
      ?f2 <- (beneficiu_mediu pret_actual ?id ?vbf)
      =>
      (retract ?f1 ?f2)
      (format d "    %4.2f    %6.3f" ?vpf ?vbf)
      (if (neq (length$ $?last) 0) 
       then (assert (lista_firme_de_afisat $?last))
;           (printout t " |") 
       else ; (printout t t)
            (format d " %n"))
)

(defrule close_file_1
      (declare (salience -20))
      =>
      (close d)
)

(defrule close_file_2
      (declare (salience 20))
      (firma (nume ?id) (lista_preturi $?))
      ?f <- (lista_firme ?id $?)
      (test (>= ?*step* 100))		; dupa 100 de pasi se opreste automat
      =>
      (retract ?f)
      (assert (valoare_pret toate_firmele stop))
)

;============================================================================
;
;	   REGULI PENTRU CALCULUL BENEFICIULUI MEDIU
;	      SI A MEDIEI PRETURILOR CONCURENTEI
;
;============================================================================

; Se goleste lista preturilor practicate de concurenta unei firme ?id pentru
; a fi reactualizata cu preturile calulate in ciclul urmator de functionare.

(defrule adaugare_pret_concurenta_in_lista
      ?f1 <- (adauga_pret_concurenta ?id ?vpic)
      ?f2 <- (preturi_concurenta ?id $?first)
      =>
      (retract ?f1 ?f2)
      (assert (preturi_concurenta ?id $?first ?vpic))
)

(defrule calcul_medie_preturi_concurenta
      (declare (salience -3))
      ?f <- (preturi_concurenta ?id $?vp)
      (firma (nume ?id) (nfc ?nfc &: (eq ?nfc (length$ $?vp)) ))
      =>
      (retract ?f)
      (assert (preturi_concurenta ?id)
              (medie_preturi_concurenta ?id (/ (+ (expand$ $?vp)) ?nfc)) )
)

(defrule adaugare_beneficiu_firma_in_lista_1
      (or ?f <- (valoare_beneficiu ?tip &~pret_intarziat ?id ? ?vb)
	  ?f <- (valoare_beneficiu ?tip &pret_intarziat ? ?id ?vb) )
      (not (lista_beneficii ?tip ?id $?))
      =>
      (retract ?f)
      (assert (lista_beneficii ?tip ?id ?vb))
)

(defrule adugare_beneficiu_firma_in_lista_2
      (or ?f1 <- (valoare_beneficiu ?tip &~pret_intarziat ?id ? ?vb)
	  ?f1 <- (valoare_beneficiu ?tip &pret_intarziat ? ?id ?vb) )
      ?f2 <- (lista_beneficii ?tip ?id $?lvb)
      =>
      (retract ?f1 ?f2)
      (assert (lista_beneficii ?tip ?id $?lvb ?vb))
)

(defrule calcul_beneficiu_mediu_firma
      (declare (salience -3))
      ?f <- (lista_beneficii ?tip ?id $?vb)
      (firma (nume ?id) (nfc ?nfc &: (eq ?nfc (length$ $?vb)) ))
      =>
      (retract ?f)
      (assert (beneficiu_mediu ?tip ?id (/ (+ (expand$ $?vb)) ?nfc)) )
)

;============================================================================
;
;	    REGULI PENTRU MODIFICAREA PRETURILOR
;
;============================================================================

;    STRATEGIE: COMP-PROFIT
;    Regulile urmatoare compara beneficiul obtinut de firma la pretul actual 
; practicat de aceasta, cu beneficiul mediu obtinut de concurenta la pret 
; intarziat si se stabilesc modificarile ce vor fi efectuate:
;    Daca beneficul firmei este mai mic:
;    - se compara pretul actual cu "media" preturilor firmelor concurente si 
;      daca acesta este mai mare/mic decat aceasta media se realizeaza o 
;      scadere/crestere a pretului
;    Daca beneficul firmei este mai mare:
;    - se va evalua beneficiul obtinut daca produsul firmei ar avea un pret 
;      actual mai mare / mai mic (op. de maximizare)

(defrule modificare_pret_daca_beneficiu_mic
      (declare(salience -6))
      (firma (nume ?id) (strategie comp-profit) (lista_preturi ?vp1 $?))
      ?f1 <- (medie_preturi_concurenta ?id ?vp2)
      (beneficiu_mediu pret_actual ?id ?vb1)
      ?f2 <- (beneficiu_mediu pret_intarziat ?id ?vb2 &:(< ?vb1 ?vb2))
      =>
      (retract ?f1 ?f2)
      (if (<= ?vp1 ?vp2)
       then (assert (valoare_pret ?id creste))
       else (assert (valoare_pret ?id scade)) )
)

(defrule modificare_pret_daca_beneficiu_mare
      (declare(salience -5))
      (firma (nume ?id) (strategie comp-profit))
      (beneficiu_mediu pret_actual ?id ?vb1)
      ?f1 <- (beneficiu_mediu pret_intarziat ?id ?vb2 &:(>= ?vb1 ?vb2))
      ?f2 <- (medie_preturi_concurenta ?id ?vp2)
      =>
      (retract ?f1 ?f2)
      (assert (evaluare_beneficiu ?id))
)
; Se modifica pretul pentru a obtine un beneficiu mai mare (op. de maximizare) 
; realizata cu strategia max-profit

(defrule eliminare_fapt_flag
      (declare (salience -4))
      ?f <- (evaluare_beneficiu ?id)
      =>
      (retract ?f )
)

;    STRATEGIE: MAX-PROFIT
;    Firma nu mai tine cont de beneficul (preturile) concurentei atunci cand
; isi modifica pretul de vanzare, singurul scop imediat fiind de asi maximiza
; profitul. In functie de valorile beneficiilor obtinute la un pret mai 
; ridicat / scazut se ia decizia de a pastra acelasi pret sau de al modifica.
; Regula este aproape identica cu 'modificare_pret_daca_beneficiu_mare'.

(defrule modificare_pret_functie_de_beneficiul_maxim
      (declare (salience -6))
      (beneficiu_mediu pret_actual ?id ?vbpa)
      ?f1 <- (beneficiu_mediu pret_mai_ridicat ?id ?vbpr)
      ?f2 <- (beneficiu_mediu pret_mai_scazut ?id ?vbps)
      =>
      (retract ?f1 ?f2)
      (switch (max ?vbpa ?vbpr ?vbps)
            (case ?vbps then (assert (valoare_pret ?id scade)) )
            (case ?vbpa then (assert (valoare_pret ?id aceiasi)) )
            (case ?vbpr then (assert (valoare_pret ?id creste)) )
      )
)
 

; Se modifica listele de preturi punand in fata noul pret si eliminand 
; ultimul element din lista (pentru a pastra dimensiunile listelor)

(defrule valoare_pret_creste
      (declare (salience -15))
      ?f1 <- (firma (nume ?id) (tip_fa ?fa) (lista_preturi ?vp $?lista))
      ?f2 <- (valoare_pret ?id creste)
      (or (and ?f3 <- (valoare_increment ?id ?incr)
                      (firma (nume ?id) (tip_incr ?tip &fuzzy)) )
	  ?f3 <- (firma (nume ?id) (tip_incr ?tip &fix) (val_incr ?incr)) )
      =>
      (retract ?f1 ?f2)
      (if (eq ?tip fuzzy) then (retract ?f3))
      (if (> (bind ?vp_next (+ ?vp ?incr)) (get-u-to (sym-cat pret ?fa)) )
       then (bind ?vp_next (get-u-to (sym-cat pret ?fa)) ))
      (bind ?lista (create$ ?vp_next ?vp $?lista))
      (modify ?f1 (lista_preturi (subseq$ $?lista 1 (- (length$ $?lista) 1))))
)

(defrule valoare_pret_scade
      (declare (salience -15))
      ?f1 <- (firma (nume ?id) (tip_fa ?fa) (lista_preturi ?vp $?lista))
      ?f2 <- (valoare_pret ?id scade)
      (or (and ?f3 <- (valoare_increment ?id ?incr)
                      (firma (nume ?id) (tip_incr ?tip &fuzzy)) )
          ?f3 <- (firma (nume ?id) (tip_incr ?tip &fix) (val_incr ?incr)) )
      =>
      (retract ?f1 ?f2)
      (if (eq ?tip fuzzy) then (retract ?f3))
      (if (< (bind ?vp_next (- ?vp ?incr)) (get-u-from (sym-cat pret ?fa)) )
       then (bind ?vp_next (get-u-from (sym-cat pret ?fa)) ))
      (bind ?lista (create$ ?vp_next ?vp $?lista))
      (modify ?f1 (lista_preturi (subseq$ $?lista 1 (- (length$ $?lista) 1))))
)

; chiar daca lista preturilor ramane aceiasi (are toate valorile identice)
; trebuie modificat faptul (schimbata adresa de fapt) pentru a activa regula

(defrule aceiasi_valoare_pret
      (declare (salience -15))
      ?f1 <- (firma (nume ?id) (lista_preturi ?vp $?lista))
      ?f2 <- (valoare_pret ?id aceiasi)
      (or (and ?f3 <- (valoare_increment ?id ?incr)
               (firma (nume ?id) (tip_incr ?tip &fuzzy)) )
      ?f3 <- (firma (nume ?id) (tip_incr ?tip &fix) (val_incr ?incr)) )
      =>
      (retract ?f1 ?f2)
      (if (eq ?tip fuzzy) then (retract ?f3))
      (modify ?f1 (lista_preturi ?vp ?vp (subseq$ $?lista 1 (- (length$ $?lista) 1))))
)

;============================================================================
;
;	    CONSTRUCTII + REGULI FUZZY INCREMENT
;
;============================================================================

(deftemplate dif_profit
	-90 90
	((large_negative (-40 1) (-15 0))
	 (negative (-40 0) (-15 1) (0 0))
	 (zero (-15 0) (0 1) (15 0))
	 (positive (0 0) (15 1) (40 0))
	 (large_positive (15 0) (40 1))
)	)

(deftemplate increment
	0 2 USD
	((mic (0 1) (0.3 0))
	 (mediu (0.2 0) (0.4 1) (0.7 0))
	 (mare (0.5 0) (1 1))
)	)

(defrule dif_profit_large_negative
	(dif_profit large_negative)
	=>
	(assert (increment mare))
)
(defrule dif_profit_negative
	(dif_profit negative)
	=>
	(assert (increment mediu))
)
(defrule dif_profit_zero
	(dif_profit zero)
	=>
	(assert (increment mic))
)
(defrule dif_profit_positive
	(dif_profit positive)
	=>
	(assert (increment mediu))
)
(defrule dif_profit_large_positive
	(dif_profit large_positive)
	=>
	(assert (increment mare))
)
(defrule fuzificare_diferenta_beneficii
	(declare (salience -4))
	(firma (nume ?id) (tip_incr fuzzy))
	(beneficiu_mediu pret_actual ?id ?vbmpa)
	?f <- (beneficiu_mediu pret_intarziat ?id ?vbmpi)
	(firma (nume ?id) (strategie ?str))
	=>
	(if (eq ?str max-profit) then (retract ?f) )
	(assert (calcul_increment ?id)
		(dif_profit (PI 0 (- ?vbmpa ?vbmpi)) ))
)
(defrule calcul_valoare_crisp_increment
	(declare (salience -1))
	(firma (nume ?id) (tip_incr fuzzy))
	?f1 <- (increment ?)
	?f2 <- (calcul_increment ?id)
	?f3 <- (dif_profit ?)
	=>
	(retract ?f1 ?f2 ?f3)
	(assert (valoare_increment ?id (moment-defuzzify ?f1)))
)