;;; ==========================================
;;;  SISTEMA EXPERTO DE IDENTIFICACIÓN ANIMAL
;;; ==========================================
 
(defvar *rules* nil)         ; Nuestra base de conocimientos (reglas)
(defvar *known-facts* nil)   ; Lo que vamos aprendiendo del animal actual
(defvar *asked-questions* nil) 
 
(defun init-rules ()
  "Definimos las reglas de lógica. El símbolo -> separa premisas de la conclusión."
  (setf *rules*
    '(
       ;; Reglas de clasificación base (Categorías)
       (has-hair -> mammal)
       (gives-milk -> mammal)
       (has-feathers -> bird)
       (mammal eats-meat -> carnivore)
       (mammal has-pointed-teeth has-claws forward-eyes -> carnivore)
       (mammal has-hooves -> ungulate)
       (bird flies -> bird-prey)
       (bird-ungulate black-white (not flies) -> ostrich)
 
       ;; Identificación de animales específicos
       (carnivore tawny dark-spots -> cheetah)
       (carnivore tawny black-stripes -> tiger)
       (ungulate long-neck dark-spots (not carnivore) -> giraffe)
       (ungulate black-stripes -> zebra)
       (bird swims (not flies) black-white -> penguin)
       (bird-prey large -> albatross)
 
       ;; --- NUEVOS ANIMALES ---
       ;; Un zorro: es un carnívoro, pequeño y tiene una cola peluda
       (carnivore small bushy-tail -> fox)
       ;; Un pollo: es un ave, vive en granja y (generalmente) no vuela
       (bird farm-animal (not flies) -> chicken)
     ))
)
 
;; --- FUNCIONES DE APOYO ---
 
(defun split-rule (rule)
  "Corta la regla para saber qué necesitamos (condiciones) y qué obtenemos (conclusión)."
  (let ((arrow-pos (position '-> rule)))
    (if arrow-pos
        (values (subseq rule 0 arrow-pos) (nth (+ arrow-pos 1) rule))
        (error "La regla no tiene flecha '->': ~A" rule))))
 
(defun get-user-input (question)
  "Le pregunta al usuario. 'Is it true?' significa '¿Es cierto?'."
  (let ((fact-true (member question *known-facts* :test #'equal))
        (fact-false (member `(not ,question) *known-facts* :test #'equal)))
    (cond
      (fact-true t)
      (fact-false nil)
      (t
       ;; Usamos ~A para insertar la pregunta en el texto
       (format t "~%* Is it true that it ~A? (y/n) > " question)
       (finish-output)
       (let ((ans (read)))
         (cond
           ((member ans '(y Y yes YES)) 
            (push question *known-facts*)
            t)
           ((member ans '(n N no NO)) 
            (push `(not ,question) *known-facts*)
            nil)
           (t (format t "Please answer 'y' or 'n'.~%")
              (get-user-input question))))))))
 
(defun check-condition (condition)
  "Analiza si una condición se cumple, manejando el caso de las negaciones (not X)."
  (if (and (listp condition) (eq (car condition) 'not))
      (not (check-condition (cadr condition)))
      (get-user-input condition)))
 
;; --- EL MOTOR LÓGICO ---
 
(defun prove-goal (goal)
  "Intenta demostrar una meta buscando reglas que la respalden."
  (if (member goal *known-facts* :test #'equal) 
      t
      (loop for rule in *rules* do
        (multiple-value-bind (conditions conclusion) (split-rule rule)
          (when (equal goal conclusion)
            (format t "~%Checking if it is a ~A..." goal)
            ;; Si todas las condiciones de la regla son ciertas, ¡lo encontramos!
            (if (every #'check-condition conditions)
                (progn
                  (push goal *known-facts*)
                  (return-from prove-goal t))))))
      nil))
 
;; --- INTERACCIÓN PRINCIPAL ---
 
(defun identify-animal ()
  "Función principal: limpia la memoria y recorre la lista de posibles animales."
  (setf *known-facts* nil)
  (init-rules)
  (format t "--- System Ready! Let's find the animal ---~%")
 
  ;; Añadimos fox y chicken a la lista de búsqueda
  (let ((animals '(cheetah tiger giraffe zebra penguin albatross ostrich fox chicken))
        (found nil))
 
    (dolist (animal animals)
      (when (prove-goal animal)
        (setf found animal)
        (return)))
 
    (format t "~%========================================")
    (if found
        (format t "~%*** RESULT: It is a ~A! ***" found)
        (format t "~%*** RESULT: I don't know this animal. ***"))
    (format t "~%========================================~%"))
)
 
;; Para iniciar el sistema: (identify-animal)

Ozs7ID09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PQo7OzsgIFNJU1RFTUEgRVhQRVJUTyBERSBJREVOVElGSUNBQ0nDk04gQU5JTUFMCjs7OyA9PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT0KCihkZWZ2YXIgKnJ1bGVzKiBuaWwpICAgICAgICAgOyBOdWVzdHJhIGJhc2UgZGUgY29ub2NpbWllbnRvcyAocmVnbGFzKQooZGVmdmFyICprbm93bi1mYWN0cyogbmlsKSAgIDsgTG8gcXVlIHZhbW9zIGFwcmVuZGllbmRvIGRlbCBhbmltYWwgYWN0dWFsCihkZWZ2YXIgKmFza2VkLXF1ZXN0aW9ucyogbmlsKSAKCihkZWZ1biBpbml0LXJ1bGVzICgpCiAgIkRlZmluaW1vcyBsYXMgcmVnbGFzIGRlIGzDs2dpY2EuIEVsIHPDrW1ib2xvIC0+IHNlcGFyYSBwcmVtaXNhcyBkZSBsYSBjb25jbHVzacOzbi4iCiAgKHNldGYgKnJ1bGVzKgogICAgJygKICAgICAgIDs7IFJlZ2xhcyBkZSBjbGFzaWZpY2FjacOzbiBiYXNlIChDYXRlZ29yw61hcykKICAgICAgIChoYXMtaGFpciAtPiBtYW1tYWwpCiAgICAgICAoZ2l2ZXMtbWlsayAtPiBtYW1tYWwpCiAgICAgICAoaGFzLWZlYXRoZXJzIC0+IGJpcmQpCiAgICAgICAobWFtbWFsIGVhdHMtbWVhdCAtPiBjYXJuaXZvcmUpCiAgICAgICAobWFtbWFsIGhhcy1wb2ludGVkLXRlZXRoIGhhcy1jbGF3cyBmb3J3YXJkLWV5ZXMgLT4gY2Fybml2b3JlKQogICAgICAgKG1hbW1hbCBoYXMtaG9vdmVzIC0+IHVuZ3VsYXRlKQogICAgICAgKGJpcmQgZmxpZXMgLT4gYmlyZC1wcmV5KQogICAgICAgKGJpcmQtdW5ndWxhdGUgYmxhY2std2hpdGUgKG5vdCBmbGllcykgLT4gb3N0cmljaCkKCiAgICAgICA7OyBJZGVudGlmaWNhY2nDs24gZGUgYW5pbWFsZXMgZXNwZWPDrWZpY29zCiAgICAgICAoY2Fybml2b3JlIHRhd255IGRhcmstc3BvdHMgLT4gY2hlZXRhaCkKICAgICAgIChjYXJuaXZvcmUgdGF3bnkgYmxhY2stc3RyaXBlcyAtPiB0aWdlcikKICAgICAgICh1bmd1bGF0ZSBsb25nLW5lY2sgZGFyay1zcG90cyAobm90IGNhcm5pdm9yZSkgLT4gZ2lyYWZmZSkKICAgICAgICh1bmd1bGF0ZSBibGFjay1zdHJpcGVzIC0+IHplYnJhKQogICAgICAgKGJpcmQgc3dpbXMgKG5vdCBmbGllcykgYmxhY2std2hpdGUgLT4gcGVuZ3VpbikKICAgICAgIChiaXJkLXByZXkgbGFyZ2UgLT4gYWxiYXRyb3NzKQogICAgICAgCiAgICAgICA7OyAtLS0gTlVFVk9TIEFOSU1BTEVTIC0tLQogICAgICAgOzsgVW4gem9ycm86IGVzIHVuIGNhcm7DrXZvcm8sIHBlcXVlw7FvIHkgdGllbmUgdW5hIGNvbGEgcGVsdWRhCiAgICAgICAoY2Fybml2b3JlIHNtYWxsIGJ1c2h5LXRhaWwgLT4gZm94KQogICAgICAgOzsgVW4gcG9sbG86IGVzIHVuIGF2ZSwgdml2ZSBlbiBncmFuamEgeSAoZ2VuZXJhbG1lbnRlKSBubyB2dWVsYQogICAgICAgKGJpcmQgZmFybS1hbmltYWwgKG5vdCBmbGllcykgLT4gY2hpY2tlbikKICAgICApKQopCgo7OyAtLS0gRlVOQ0lPTkVTIERFIEFQT1lPIC0tLQoKKGRlZnVuIHNwbGl0LXJ1bGUgKHJ1bGUpCiAgIkNvcnRhIGxhIHJlZ2xhIHBhcmEgc2FiZXIgcXXDqSBuZWNlc2l0YW1vcyAoY29uZGljaW9uZXMpIHkgcXXDqSBvYnRlbmVtb3MgKGNvbmNsdXNpw7NuKS4iCiAgKGxldCAoKGFycm93LXBvcyAocG9zaXRpb24gJy0+IHJ1bGUpKSkKICAgIChpZiBhcnJvdy1wb3MKICAgICAgICAodmFsdWVzIChzdWJzZXEgcnVsZSAwIGFycm93LXBvcykgKG50aCAoKyBhcnJvdy1wb3MgMSkgcnVsZSkpCiAgICAgICAgKGVycm9yICJMYSByZWdsYSBubyB0aWVuZSBmbGVjaGEgJy0+JzogfkEiIHJ1bGUpKSkpCgooZGVmdW4gZ2V0LXVzZXItaW5wdXQgKHF1ZXN0aW9uKQogICJMZSBwcmVndW50YSBhbCB1c3VhcmlvLiAnSXMgaXQgdHJ1ZT8nIHNpZ25pZmljYSAnwr9FcyBjaWVydG8/Jy4iCiAgKGxldCAoKGZhY3QtdHJ1ZSAobWVtYmVyIHF1ZXN0aW9uICprbm93bi1mYWN0cyogOnRlc3QgIydlcXVhbCkpCiAgICAgICAgKGZhY3QtZmFsc2UgKG1lbWJlciBgKG5vdCAscXVlc3Rpb24pICprbm93bi1mYWN0cyogOnRlc3QgIydlcXVhbCkpKQogICAgKGNvbmQKICAgICAgKGZhY3QtdHJ1ZSB0KQogICAgICAoZmFjdC1mYWxzZSBuaWwpCiAgICAgICh0CiAgICAgICA7OyBVc2Ftb3MgfkEgcGFyYSBpbnNlcnRhciBsYSBwcmVndW50YSBlbiBlbCB0ZXh0bwogICAgICAgKGZvcm1hdCB0ICJ+JSogSXMgaXQgdHJ1ZSB0aGF0IGl0IH5BPyAoeS9uKSA+ICIgcXVlc3Rpb24pCiAgICAgICAoZmluaXNoLW91dHB1dCkKICAgICAgIChsZXQgKChhbnMgKHJlYWQpKSkKICAgICAgICAgKGNvbmQKICAgICAgICAgICAoKG1lbWJlciBhbnMgJyh5IFkgeWVzIFlFUykpIAogICAgICAgICAgICAocHVzaCBxdWVzdGlvbiAqa25vd24tZmFjdHMqKQogICAgICAgICAgICB0KQogICAgICAgICAgICgobWVtYmVyIGFucyAnKG4gTiBubyBOTykpIAogICAgICAgICAgICAocHVzaCBgKG5vdCAscXVlc3Rpb24pICprbm93bi1mYWN0cyopCiAgICAgICAgICAgIG5pbCkKICAgICAgICAgICAodCAoZm9ybWF0IHQgIlBsZWFzZSBhbnN3ZXIgJ3knIG9yICduJy5+JSIpCiAgICAgICAgICAgICAgKGdldC11c2VyLWlucHV0IHF1ZXN0aW9uKSkpKSkpKSkKCihkZWZ1biBjaGVjay1jb25kaXRpb24gKGNvbmRpdGlvbikKICAiQW5hbGl6YSBzaSB1bmEgY29uZGljacOzbiBzZSBjdW1wbGUsIG1hbmVqYW5kbyBlbCBjYXNvIGRlIGxhcyBuZWdhY2lvbmVzIChub3QgWCkuIgogIChpZiAoYW5kIChsaXN0cCBjb25kaXRpb24pIChlcSAoY2FyIGNvbmRpdGlvbikgJ25vdCkpCiAgICAgIChub3QgKGNoZWNrLWNvbmRpdGlvbiAoY2FkciBjb25kaXRpb24pKSkKICAgICAgKGdldC11c2VyLWlucHV0IGNvbmRpdGlvbikpKQoKOzsgLS0tIEVMIE1PVE9SIEzDk0dJQ08gLS0tCgooZGVmdW4gcHJvdmUtZ29hbCAoZ29hbCkKICAiSW50ZW50YSBkZW1vc3RyYXIgdW5hIG1ldGEgYnVzY2FuZG8gcmVnbGFzIHF1ZSBsYSByZXNwYWxkZW4uIgogIChpZiAobWVtYmVyIGdvYWwgKmtub3duLWZhY3RzKiA6dGVzdCAjJ2VxdWFsKSAKICAgICAgdAogICAgICAobG9vcCBmb3IgcnVsZSBpbiAqcnVsZXMqIGRvCiAgICAgICAgKG11bHRpcGxlLXZhbHVlLWJpbmQgKGNvbmRpdGlvbnMgY29uY2x1c2lvbikgKHNwbGl0LXJ1bGUgcnVsZSkKICAgICAgICAgICh3aGVuIChlcXVhbCBnb2FsIGNvbmNsdXNpb24pCiAgICAgICAgICAgIChmb3JtYXQgdCAifiVDaGVja2luZyBpZiBpdCBpcyBhIH5BLi4uIiBnb2FsKQogICAgICAgICAgICA7OyBTaSB0b2RhcyBsYXMgY29uZGljaW9uZXMgZGUgbGEgcmVnbGEgc29uIGNpZXJ0YXMsIMKhbG8gZW5jb250cmFtb3MhCiAgICAgICAgICAgIChpZiAoZXZlcnkgIydjaGVjay1jb25kaXRpb24gY29uZGl0aW9ucykKICAgICAgICAgICAgICAgIChwcm9nbgogICAgICAgICAgICAgICAgICAocHVzaCBnb2FsICprbm93bi1mYWN0cyopCiAgICAgICAgICAgICAgICAgIChyZXR1cm4tZnJvbSBwcm92ZS1nb2FsIHQpKSkpKSkKICAgICAgbmlsKSkKCjs7IC0tLSBJTlRFUkFDQ0nDk04gUFJJTkNJUEFMIC0tLQoKKGRlZnVuIGlkZW50aWZ5LWFuaW1hbCAoKQogICJGdW5jacOzbiBwcmluY2lwYWw6IGxpbXBpYSBsYSBtZW1vcmlhIHkgcmVjb3JyZSBsYSBsaXN0YSBkZSBwb3NpYmxlcyBhbmltYWxlcy4iCiAgKHNldGYgKmtub3duLWZhY3RzKiBuaWwpCiAgKGluaXQtcnVsZXMpCiAgKGZvcm1hdCB0ICItLS0gU3lzdGVtIFJlYWR5ISBMZXQncyBmaW5kIHRoZSBhbmltYWwgLS0tfiUiKQogIAogIDs7IEHDsWFkaW1vcyBmb3ggeSBjaGlja2VuIGEgbGEgbGlzdGEgZGUgYsO6c3F1ZWRhCiAgKGxldCAoKGFuaW1hbHMgJyhjaGVldGFoIHRpZ2VyIGdpcmFmZmUgemVicmEgcGVuZ3VpbiBhbGJhdHJvc3Mgb3N0cmljaCBmb3ggY2hpY2tlbikpCiAgICAgICAgKGZvdW5kIG5pbCkpCiAgICAKICAgIChkb2xpc3QgKGFuaW1hbCBhbmltYWxzKQogICAgICAod2hlbiAocHJvdmUtZ29hbCBhbmltYWwpCiAgICAgICAgKHNldGYgZm91bmQgYW5pbWFsKQogICAgICAgIChyZXR1cm4pKSkKICAgIAogICAgKGZvcm1hdCB0ICJ+JT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT0iKQogICAgKGlmIGZvdW5kCiAgICAgICAgKGZvcm1hdCB0ICJ+JSoqKiBSRVNVTFQ6IEl0IGlzIGEgfkEhICoqKiIgZm91bmQpCiAgICAgICAgKGZvcm1hdCB0ICJ+JSoqKiBSRVNVTFQ6IEkgZG9uJ3Qga25vdyB0aGlzIGFuaW1hbC4gKioqIikpCiAgICAoZm9ybWF0IHQgIn4lPT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PX4lIikpCikKCjs7IFBhcmEgaW5pY2lhciBlbCBzaXN0ZW1hOiAoaWRlbnRpZnktYW5pbWFsKQ==