Add negative-example and positive-example methods.

lisp/version_space.lisp

@@ -78,6 +78,85 @@
   )
 )
 
+;; Der Versionsraum `vs` wird mit Hilfe des Positiv-Beispiels
+;; `example` verfeinert
+(defun positive-example (vs example)
+  (let ((VS_G (first vs)) (VS_S (second vs)))
+    ;; Ein neuer Versionsraum...
+    (list
+      ;; VS_G ohne diejenigen Hypothesen,
+      ;; die das Positiv-Beispiel nicht enthalten
+      (remove-if-not #'(lambda (g) (more-general? g example)) VS_G)
+
+      ;; Streiche alle Elemente der neuen VS_S-Menge,
+      ;; die allgemeiner sind als ein Element von VS_G
+      (remove-if-not
+        #'(lambda (s) (notany #'(lambda (g) (more-general? s g)) VS_G))
+        (mapcar #'(lambda (s)
+          ;; Ersetze alle Elemente aus S, die das Positiv-Beispiel nicht
+          ;; enthalten durch eine Verallgemeinerung
+          (if (not (more-general? s example))
+            (generalize s example)
+            s
+          )
+        ) VS_S)
+      )
+    )
+  )
+)
+
+;; Der Versionsraum `vs` wird mit dem übergebenen Negativ-Beispiel
+;; `example` verfeinert.
+(defun negative-example (vs example)
+  (let ((VS_G (first vs)) (VS_S (second vs)))
+    ;; Ein neuer Versionsraum ...
+    (list
+      (reduce #'(lambda (acc g)
+        (if
+          (not (more-general? g example))
+          (append acc (list g))
+          (append acc
+            ;; Generiere alle Spezialisierungen und sammele diejenigen, die alle
+            ;; Kriterien erfüllen.
+            (reduce #'(lambda (acc new_g)
+              (if
+                (and
+                  ;; Die Spezialisierung darf das negative Beispiel nicht enthalten
+                  (not (more-general? new_g example))
+                  ;; Alle bisher vorgelegten Beispiele müssen enthalten sein
+                  ;; NOTE: Das stimmt hier eigentlich nicht _direkt_. Wir testen hier
+                  ;;       eigentlich gegen die Elemente von VS_S. Da VS_S aber in unserem
+                  ;;       Fall dem positiven Beispielen entspricht, passt das soweit.
+                  (every #'(lambda (pe)
+                    (more-general? new_g pe)
+                  ) VS_S)
+                  ;; Kein Element von VS_G darf die neue Spezialisierung enthalten,
+                  ;; da sie ja sonst überflüssig ist.
+                  (notany #'(lambda (other_g)
+                    (and
+                      (not (equal g other_g))
+                      (more-general? other_g new_g)
+                    )
+                  ) VS_G)
+                )
+                ;; Die neue Spezialisierung erfüllt alle Kriterien
+                ;; -> wird zum Akkumulator hinzugefügt.
+                (append acc (list new_g))
+                ;; Die neue Spezialisierung erfüllt die Kriterien nicht
+                ;; -> wird nicht zum Akkumulator hinzugefügt.
+                acc
+              )
+            ) (specialize g example (first VS_S)) :initial-value '() )
+          )
+        )
+      ) VS_G :initial-value '() )
+
+      ;; Alle Elemente aus S entfernen, die dem negativen Beispiel entsprechen
+      (remove-if-not #'(lambda (s) (not (more-general? s example))) VS_S)
+    )  
+  )
+)
+
 ; --- how to read an exampleset from a file:
 
 ; --- helper / makes the result more readable in case there are "nil" entries

lisp/version_space_test.lisp

@@ -72,4 +72,58 @@
   )
 )
 
+(define-test test-more-complicated-saengerin
+  "should be correctly building a version space for the 'Sänger/Sängerin' example"
+  (let ((vs '((("*" "*" "*")) (("_" "_" "_")))))
+    (let ((vs (positive-example vs '("Sängerin" "Jazz" "20er-50er"))))
+      (assert-equal
+        '((("*" "*" "*")) (("Sängerin" "Jazz" "20er-50er")))
+        vs
+      )
+
+      (let ((vs (negative-example vs '("Gruppe" "Pop" "70er"))))
+        (assert-equal
+          '((("Sängerin" "*" "*") ("*" "Jazz" "*") ("*" "*" "20er-50er")) (("Sängerin" "Jazz" "20er-50er")))
+          vs
+        )
+
+        (let ((vs (negative-example vs '("Gruppe" "Pop" "80er"))))
+          (assert-equal
+            '((("Sängerin" "*" "*") ("*" "Jazz" "*") ("*" "*" "20er-50er")) (("Sängerin" "Jazz" "20er-50er")))
+            vs
+          )
+
+          (let ((vs (negative-example vs '("Sänger" "Jazz" "20er-50er"))))
+            (assert-equal
+              '((("Sängerin" "*" "*")) (("Sängerin" "Jazz" "20er-50er")))
+              vs
+            )
+
+            (let ((vs (positive-example vs '("Sängerin" "Jazz" "50er-60er"))))
+              (assert-equal
+                '((("Sängerin" "*" "*")) (("Sängerin" "Jazz" "*")))
+                vs
+              )
+
+              (let ((vs (negative-example vs '("Orchester" "Klassik" "vor 1920"))))
+                (assert-equal
+                  '((("Sängerin" "*" "*")) (("Sängerin" "Jazz" "*")))
+                  vs
+                )
+
+                (let ((vs (positive-example vs '("Sängerin" "Jazz" "70er"))))
+                  (assert-equal
+                    '((("Sängerin" "*" "*")) (("Sängerin" "Jazz" "*")))
+                    vs
+                  )
+                )
+              )
+            )
+          )
+        )
+      )
+    )
+  )
+)
+
 (run-tests)