kenkeiras/lang-model
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Base concept.

Browse Source
This commit is contained in:
kenkeiras 2017-05-09 22:21:22 +02:00
commit 063d6d3836
4 changed files with 240318 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

149
ast/gac-80k-affirmations.lisp Normal file
View File

@ -0,0 +1,149 @@
(defobs 1.00 "icecream is cold"
(exists-property-with-value 'icecream 'cold))
(defobs 1.00 "earth is a planet"
(pertenence-to-group 'earth 'planet))
(defobs 1.00 "Green is a color"
(pertenence-to-group 'green 'color))
(defobs 1.00 "airplanes do fly"
(exists
(capacity 'airplane 'fly)))
;; (defobs 1.00 "Is it hot during the summer?"
;; (question
;; (during 'summer
;; (exists-property-with-value
;; 'context 'hot))))
;; (defobs 1.00 "is chile in south america ?"
;; (question
;; (pertenence-to-group 'chile 'south-america)))
;; (defobs 1.00 "Was Socrates a man?"
;; (question
;; (pertenence-to-group 'socrates 'man)))
;; (defobs 1.00 "Computers use electricity?"
;; (question
;; (capacity 'computer
;; (verb 'use 'electricity))))
;; (defobs 1.00 "The dominant language in france is french?"
;; (question
;; (is-equal 'french
;; (property 'france 'dominant-language))))
;; (defobs 1.00 "was abraham lincoln once president of the united states?"
;; (question
;; (time-frame 'past
;; (is-equal 'abramham-lincoln
;; (property 'united-states 'president)))))
;; (defobs 1.00 "Is milk white?"
;; (question
;; (exists-property-with-value 'milk 'white)))
;; (defobs 1.00 "do people have emotions?"
;; (question
;; (some-element-which-complies-with
;; 'X
;; (element-of-group-has-property 'element 'X 'emotions))))
;; (defobs 1.00 "do objects appear smaller as they move away from you?"
;; (question
;; (all-element-complies-with
;; 'X
;; (during (verb 'moving 'away)
;; ; How to model apparence...?
;; (exists-property-with-value 'X 'smaller)))))
;; (defobs 1.00 "Does the human species have a male and female gender?"
;; (question
;; (all-element-of-group-complies-with
;; 'X 'human
;; (q-or (is-equal (property 'X 'gender) 'male)
;; (is-equal (property 'X 'gender) 'female)))))
;; (defobs 1.00 "Is a mountain mostly made of rock?"
;; (question
;; (all-element-of-group-complies-with
;; 'X 'mountain
;; (is-equal 'rock
;; (property 'X 'made-of)))))
;; (defobs 1.00 "is sun microsystems a computer company?"
;; (question
;; (pertenence-to-group
;; 'sun-microsystems
;; 'computer-company)))
;; (defobs 1.00 "Do you see with your eyes and smell with your nose?"
;; (question ; How to model reflectiveness... ?
;; (q-and (exists (capacity 'eyes 'see))
;; (exists (capacity 'nose 'smell)))))
;; (defobs 1.00 "Is smoking bad for your health?"
;; (question ; How to model reflectiveness again...?
;; (implies (verb 'smoke '())
;; (property 'health 'bad))))
;; (defobs 1.00 "Does a dog have four legs?"
;; (question
;; ; How to separate quantity from property... ?
;; (is-equal 'four
;; (quantity
;; (property
;; 'dog
;; 'leg)))))
;; (defobs 1.00 "Do mammals have hearts?"
;; (question
;; (all-element-of-group-complies-with
;; ; Properties don't quite fit...
;; 'X 'mammal
;; (exists-property-with-value 'X 'heart))))
;; (defobs 1.00 "is the Earth a planet?"
;; (question
;; (pertenence-to-group 'earth 'planet)))
;; (defobs 1.00 "Is water a liquid?"
;; (question
;; (pertenence-to-group 'water 'liquid)))
;; (defobs 1.00 "Is Bugs Bunny a cartoon character?"
;; (question
;; (pertenence-to-group 'bugs-bunny 'cartoon-character)))
;; (defobs 1.00 "Do Humans communicate by Telephone?"
;; (question
;; ; How to model communication means... ?
;; (some-element-which-complies-with
;; 'X
;; (property 'X 'communicate-by))))
;; (defobs 1.00 "is beer a drink ?"
;; (question
;; (pertenence-to-group 'beer 'drink)))
;; (defobs 1.00 "are there 12 months in a year?"
;; (question
;; (is-equal 12
;; (quantity (property 'year 'month)))))
;; (defobs 1.00 "does the sun hurt your eyes when you look at it?"
;; (question ; How to model reflectiveness again... ?
;; (implies (verb 'look '(sun))
;; (exists-property-with-value 'eyes 'hurt))))
;; (defobs 1.00 "Do most cars have doors?"
;; (question ; How to define probability... ?
;; (element-of-group-has-property 'x 'car 'door)))
;; (defobs 1.00 "is orange both a fruit and a colour?"
;; (question
;; (q-and
;; (pertenence-to-group 'orange 'fruit)
;; (pertenence-to-group 'orange 'color))))

240033
ast/gac-80k.lisp Normal file
View File

File diff suppressed because it is too large Load Diff

39
ast/knowledge.lisp Normal file
View File

@ -0,0 +1,39 @@
(defun (setf question) (answer quest)
(give-answer quest answer))
(defun give-answer (quest answer)
(format t "From now on ~a -> ~a~%" quest answer)
answer)
(defun question (x)
(format t "Question: ~a~%" x))
(defvar *OBSERVATION-NUMBER* 0)
(defmacro defobs (obs input parsed)
"Defines a new input-parsed pair."
(when parsed
(incf *OBSERVATION-NUMBER*)
(format t "> ~a" input)
(let ((listv (gensym))
(obsv (gensym)))
`(let ((,listv ',parsed)
(,obsv ,obs))
(case ,obsv
(1.00
(progn
(format t " || Yes~%")
(setf ,parsed t))))))))
;; Basic operators
(load "operators.lisp")
;; Load knowledge base
(load "gac-80k-affirmations.lisp")
(load "gac-80k.lisp")
;; Stats
(format t "~%Read ~a observations.~%" *OBSERVATION-NUMBER*)

97
ast/operators.lisp Normal file
View File

@ -0,0 +1,97 @@
;; Properties
(defun exists (object)
"The object is not unexistent."
(list '∃ object))
(defun property (element property)
"Evaluates a given property of an object."
(list element "." property))
(defun capacity (element capacity)
"Evaluates a given capacity (skill) of an element."
(list element "||" capacity))
(defun quantity (elements)
"Evaluates the quantity of the results of an operator."
(list 'count elements))
(defun pertenence-to-group (element group)
"Evaluates the pertenence of the element to a group."
(list element "∈" group))
(defun (setf pertenence-to-group) (result object value)
'todo=create-virtual-node)
(defun during (time events)
"Evaluates the events during some condition."
(list 'while "(" time ")" events))
(defun is-equal (pred1 pred2)
"Evaluetes the equality of two predicates."
(list pred1 "=" pred2))
(defun verb (verb-name subject)
"Applies a vert to a subject."
(list verb-name (list subject)))
;; Algebra
(defun product (times element)
(list 'times times element))
;; Time
(defun time-frame (time value)
"Evaluates a value during a time-frame."
(list 'time time '\, value))
;; Evaluation
(defun some-element-which-complies-with (var condition)
"Evaluates if some element complies with a condition."
(list 'some var '\, condition))
(defun all-element-complies-with (var condition)
"Evaluates if some every complies with a condition."
(list 'all var '\, condition))
(defun q-and (pred1 pred2)
"Evaluates the intersection of two predicates."
(list 'and pred1 pred2))
(defun q-or (pred1 pred2)
"Evaluates the union of two predicates."
(list 'or pred1 pred2))
(defun q-not (pred)
"Evaluates the negation of a predicate."
(list 'not pred))
;;;; Composed
(defun exists-property-with-value (object value)
"Evaluates the existence of a property with a given value in the object."
(exists
(some-element-which-complies-with
'P
(is-equal value
(property object 'P)))))
(defun (setf exists-property-with-value) (result object value)
'todo=create-virtual-node)
(defun element-of-group-has-property (element group prop)
"Evaluates the existance of a property in the object, given the pertenence to a group."
(q-and
(pertenence-to-group element group)
(exists (property element prop))))
(defun all-element-of-group-complies-with (element group condition)
"Evaluates the compliance of a given condition given the pertenence to a group."
(all-element-complies-with
element
(q-or
(q-not (pertenence-to-group element group))
condition)))
(defun implies (a b)
(q-or (q-not a)
b))