[Javaowl-commit] reasoner/design draft.scm,1.3,1.4 reasoner.scm,1.1,1.2

[Gerardo H. <ma...@us...>]

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