Update of /cvsroot/javaowl/reasoner/design
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24912
Modified Files:
draft.scm reasoner.scm
Log Message:
First working reasoner!
Index: draft.scm
===================================================================
RCS file: /cvsroot/javaowl/reasoner/design/draft.scm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** draft.scm 7 Aug 2004 00:50:19 -0000 1.3
--- draft.scm 7 Aug 2004 01:41:57 -0000 1.4
***************
*** 40,57 ****
'((($intersection Person Female) x)
(($intersection Person ($complement Female)) y)
! (($intersection Person Female ($complement Female)) z)
(($allValuesFrom hasChild Person) a)
(hasChild a b)))
! ;(($intersection Person Female) x)
! ;(Person x)
! ;(Female x)
! ;(($intersection Person ($complement Female)) y)
! ;(Person y)
! ;(($complement Female) y)
! ;(($intersection Person Female ($complement Female)) z)
! ;(Person z)
! ;(Female z)
! ;(($complement Female) z)
!
!
--- 40,50 ----
'((($intersection Person Female) x)
(($intersection Person ($complement Female)) y)
! ; (($intersection Person Female ($complement Female)) z)
(($allValuesFrom hasChild Person) a)
(hasChild a b)))
! (define abox2
! '((Woman x)
! (Man y)
! ;(Undefined z)
! ))
\ No newline at end of file
Index: reasoner.scm
===================================================================
RCS file: /cvsroot/javaowl/reasoner/design/reasoner.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** reasoner.scm 7 Aug 2004 00:24:06 -0000 1.1
--- reasoner.scm 7 Aug 2004 01:41:57 -0000 1.2
***************
*** 161,164 ****
(rec-apply-rules abox abox)))
(define (consistent? abox)
! (not (has-contradiction? (apply-rules abox))))
\ No newline at end of file
--- 161,210 ----
(rec-apply-rules abox abox)))
+ (define (has-contradiction? abox)
+ (letrec
+ ((complement
+ (lambda (t)
+ (let ((concept (first t))
+ (instance (second t)))
+ (cond ((symbol? concept) `(($complement ,concept) ,instance))
+ (#t `(,(second concept) ,instance))))))
+ (base-concept?
+ (lambda (c)
+ (or (symbol? c)
+ (eq? (first c) '$complement)))))
+
+ (if (null? abox)
+ #f
+ (let ((term (car abox))
+ (terms (cdr abox)))
+ (if (= (length term) 3)
+ (has-contradiction? terms)
+ (if (and (base-concept? (first term))
+ (member (complement term) terms))
+ #t
+ (has-contradiction? terms)))))))
+
(define (consistent? abox)
! (not (has-contradiction? (apply-rules abox))))
!
! (define (expand-wrt-tbox abox tbox)
! (letrec
! ((etbox (expand-tbox tbox))
!
! (rec-expand-wrt-tbox
! (lambda (abox eabox)
! (if (null? abox)
! eabox
! (let ((term (car abox))
! (other-terms (cdr abox)))
! (if (= (length term) 2)
! (rec-expand-wrt-tbox other-terms
! (cons `(,(simplify (expand-concept-definition etbox (first term)))
! ,(second term))
! eabox))
! (rec-expand-wrt-tbox other-terms (cons term eabox))))))))
!
! (rec-expand-wrt-tbox abox ())))
!
! (define (consistent-wrt-tbox? abox tbox)
! (consistent? (expand-wrt-tbox abox tbox)))
\ No newline at end of file
|
