Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Heavy refactorings + more tests.

  • Loading branch information...
commit cabb7add793e10fbed5705de9965379e0fc07a23 1 parent a2337fa
@arthurschreiber authored
Showing with 45 additions and 25 deletions.
  1. +27 −23 lisp/version_space.lisp
  2. +18 −2 lisp/version_space_test.lisp
View
50 lisp/version_space.lisp
@@ -30,30 +30,34 @@
; --- specialize ---
-(defun get-potential-positions (g neg s pos poslist)
- (cond ((null g) poslist)
- ((equal (car g) "*")
- (cond ((equal (car neg) (car s))
- (get-potential-positions (cdr g) (cdr neg) (cdr s) (+ pos 1) poslist))
- (T (get-potential-positions (cdr g) (cdr neg) (cdr s) (+ pos 1) (cons pos poslist)))))
- (T (get-potential-positions (cdr g) (cdr neg) (cdr s) (+ pos 1) poslist))
-))
-
-
-(defun specialize-first-attribute (g s)
- (cond ((equal (car g) "*") (cons (car s) (cdr g)))
- (T nil)))
-
-(defun specialize-position (g neg s pos)
- (cond ((= pos 0) (specialize-first-attribute g s))
- ((> pos 0) (cons (car g)
- (specialize-position (cdr g) (cdr neg) (cdr s) (- pos 1))))))
-
-
-(defun specialize (g neg s)
- (let ((pos (get-potential-positions g neg s 0 nil)))
- (mapcar #'(lambda (x) (specialize-position g neg s x)) pos)))
+(defun position-can-be-specialized? (g_item neg_item s_item)
+ (and (equal g_item "*") (not (equal s_item neg_item)))
+)
+
+(defun get-potential-positions (g neg s)
+ ;; Holy Crap is this ugly ...
+ (loop for g_item in g
+ for neg_item in neg
+ for s_item in s
+ for i from 0
+ if (position-can-be-specialized? g_item neg_item s_item)
+ collect i
+ )
+)
+;; Spezialisiert `g` an der Position `pos`
+(defun specialize-position (g s pos)
+ (if (= pos 0)
+ (cons (first s) (rest g))
+ (cons (first g) (specialize-position (rest g) (rest s) (- pos 1)))
+ )
+)
+
+(defun specialize (g neg s)
+ (mapcar #'(lambda (pos)
+ (specialize-position g s pos)
+ ) (get-potential-positions g neg s))
+)
; --- how to read an exampleset from a file:
View
20 lisp/version_space_test.lisp
@@ -37,12 +37,28 @@
(define-test test-get-potential-positions
"should return a list of positions that can be specialized"
(assert-equal '()
- (get-potential-positions '("rund" "blau") '("rund" "gelb") '("rund" "blau") 0 '())
+ (get-potential-positions '("rund" "blau") '("rund" "gelb") '("rund" "blau"))
)
(assert-equal '(1)
- (get-potential-positions '("rund" "*") '("rund" "gelb") '("rund" "blau") 0 '())
+ (get-potential-positions '("rund" "*") '("rund" "gelb") '("rund" "blau"))
)
)
+(define-test test-specialize
+ "should return a list of specialized hypotheses"
+ (assert-equal '(("rund" "blau"))
+ (specialize '("rund" "*") '("rund" "gelb") '("rund" "blau"))
+ )
+
+ (assert-equal '(("rund" "*"))
+ (specialize '("*" "*") '("eckig" "blau") '("rund" "blau"))
+ )
+
+ (assert-equal '(("rund" "*" "*") ("*" "*" "klein"))
+ (specialize '("*" "*" "*") '("eckig" "blau" "groß") '("rund" "blau" "klein"))
+ )
+)
+
+
(run-tests)
Please sign in to comment.
Something went wrong with that request. Please try again.