From b1673233afe1ec67a4f619cb562dcc55faf26e00 Mon Sep 17 00:00:00 2001 From: Jean-Philippe Barrette-LaPierre Date: Sat, 15 Sep 2007 18:11:19 -0400 Subject: [PATCH] fixed test14 --- finenight/lisp/iadfa-run.lisp | 1 + finenight/lisp/iadfa-test.lisp | 91 +++++++--------------------------- finenight/lisp/iadfa.lisp | 86 ++++++++++++++++++++++++++++++-- finenight/lisp/package.lisp | 4 +- 4 files changed, 104 insertions(+), 78 deletions(-) diff --git a/finenight/lisp/iadfa-run.lisp b/finenight/lisp/iadfa-run.lisp index 249484b..481a8b5 100644 --- a/finenight/lisp/iadfa-run.lisp +++ b/finenight/lisp/iadfa-run.lisp @@ -10,6 +10,7 @@ (dolist (word (extract-words fsa)) (format str "~A~%" word))))) +;(detect-problems-from-file "../../data/com.zone.sorted.small") (iadfa-run) diff --git a/finenight/lisp/iadfa-test.lisp b/finenight/lisp/iadfa-test.lisp index 409b96f..0e35df3 100644 --- a/finenight/lisp/iadfa-test.lisp +++ b/finenight/lisp/iadfa-test.lisp @@ -17,79 +17,6 @@ "cappend" "cappendice" "mormont"))) -(defmacro test-equivalence (words) - (with-syms (w iadfa output) - `(let* ((,w ,words) - (,iadfa (debug-gen-iadfa ,w)) - (,output nil)) - (setf ,output (extract-words (iadfa-fsa ,iadfa))) - (format t "input:~%~S~%output:~%~S~%" ,w ,output) - (equal ,w ,output)))) - -(defun detect-problems (words) - (let ((iadfa (build-iadfa)) - (words-to-be-checked nil)) - (dolist (word words) - (setf words-to-be-checked (nconc words-to-be-checked (list word))) - (handle-word iadfa (concatenate 'list word)) - (when (not (equal words-to-be-checked - (extract-words (iadfa-fsa iadfa)))) - (return))) - ;; We got the first entry that trigger the problem. - ;; we need now to see which entry is needed to start - ;; the problem - words-to-be-checked)) - - -(defun detect-first-starting-problematic-word (words-to-be-checked) - (let ((wtbc (cdr words-to-be-checked)) - (last-word (car words-to-be-checked))) - (do ((iadfa (gen-iadfa wtbc) (gen-iadfa wtbc))) - ((null wtbc)) - (if (equal wtbc - (extract-words (iadfa-fsa iadfa))) - (return (cons last-word wtbc))) - (setf last-word (car wtbc)) - (setf wtbc (cdr wtbc))))) - -(defun filter-non-problematic-words (words-to-be-checked) - (let ((problematics-words (list (car words-to-be-checked))) - (last-word (cadr words-to-be-checked)) - (words-to-be-checked (cddr words-to-be-checked))) - (do ((iadfa (gen-iadfa (append problematics-words words-to-be-checked)) - (gen-iadfa (append problematics-words words-to-be-checked)))) - ((null words-to-be-checked)) - (if (equal (append problematics-words words-to-be-checked) - (extract-words (iadfa-fsa iadfa))) - (setf problematics-words (nconc problematics-words (list last-word)))) - (setf last-word (car words-to-be-checked)) - (setf words-to-be-checked (cdr words-to-be-checked))) - (setf problematics-words (nconc problematics-words (list last-word))) - problematics-words)) - - -(defun detect-problems-from-file (filename) - (let ((words-to-be-checked nil)) - (let ((iadfa (build-iadfa))) - (for-each-line-in-file (word filename) - (setf words-to-be-checked (nconc words-to-be-checked (list word))) - (handle-word iadfa (concatenate 'list word)) - (when (not (equal words-to-be-checked - (extract-words (iadfa-fsa iadfa)))) - (return)) - nil)) - ;; We got the first entry that trigger the problem. - ;; we need now to see which entry is needed to start - ;; the problem - (setf words-to-be-checked - (detect-first-starting-problematic-word words-to-be-checked)) - (setf words-to-be-checked - (filter-non-problematic-words words-to-be-checked)) - words-to-be-checked)) - - - -(detect-problems-from-file "../../data/com.zone.sorted.small") (defun iadfa-non-branch-suffix () "This tests that the output of the iadfa isn't screwed up @@ -211,7 +138,7 @@ produce a stem shorter than the previous stem. "0-7-2"))) (org.ancar.CLUnit::deftest "IADFA Test 12" - :category "Subsumed previs stems." + :category "Subsumed previouss stems." :test-fn #'iadfa-test12) (defun iadfa-test13 () @@ -227,6 +154,22 @@ stem" "0-500" "0-500MPH"))) +(org.ancar.CLUnit::deftest "IADFA Test 13" + :category "Subsumed previous stems." + :test-fn #'iadfa-test13) + +(defun iadfa-test14 () + "The common suffix was wrongly programmed for previous stem. +The right behavior is not to consume it, and stop when current-suffix +is equal to previous-stem." + (test-equivalence '("0-APR-CREDITS-CARD" + "0-APRCREDIT-CARD" + "0-APRCREDITCARD"))) + +(org.ancar.CLUnit::deftest "IADFA Test 14" + :category "Subsumed previous stems." + :test-fn #'iadfa-test14) + (org.ancar.CLUnit::deftest "IADFA Test 1" :category "Destinations" :test-fn #'iadfa-test1) diff --git a/finenight/lisp/iadfa.lisp b/finenight/lisp/iadfa.lisp index c66a2f3..8ea6736 100644 --- a/finenight/lisp/iadfa.lisp +++ b/finenight/lisp/iadfa.lisp @@ -181,20 +181,22 @@ (defun c-suffix (iadfa current-suffix node prefix-node profile sub-stem) (if (or (= 1 (length current-suffix)) (= 1 (length profile)) - (= 1 (length sub-stem)) + ;(= 1 (length sub-stem)) (= (length sub-stem) (length current-suffix))) (values node (reverse current-suffix) (reverse profile)) (let ((next-node (ancestror-transition iadfa node (car current-suffix) (car profile)))) ;; (if (equal '(#\0 #\- #\7) current-suffix) ;; (break)) - (if (or (not next-node) (eq next-node prefix-node) (eq next-node (fsa-start-node (iadfa-fsa iadfa)))) + (if (or (not next-node) + (eq next-node prefix-node) + (eq next-node (fsa-start-node (iadfa-fsa iadfa)))) (values node (reverse current-suffix) (reverse profile)) (c-suffix iadfa (cdr current-suffix) next-node prefix-node (cdr profile) - (cdr sub-stem)))))) + sub-stem))))) (defun common-suffix (iadfa current-suffix node prefix-node profile sub-stem) @@ -307,6 +309,84 @@ iadfa) iadfa)) + +(defmacro test-equivalence (words) + (with-syms (w iadfa output) + `(let* ((,w ,words) + (,iadfa (debug-gen-iadfa ,w)) + (,output nil)) + (setf ,output (extract-words (iadfa-fsa ,iadfa))) + (format t "input:~%~S~%output:~%~S~%" ,w ,output) + (equal ,w ,output)))) + + +(defun detect-problems (words) + (let ((iadfa (build-iadfa)) + (words-to-be-checked nil)) + (dolist (word words) + (setf words-to-be-checked (nconc words-to-be-checked (list word))) + (handle-word iadfa (concatenate 'list word)) + (when (not (equal words-to-be-checked + (extract-words (iadfa-fsa iadfa)))) + (return))) + ;; We got the first entry that trigger the problem. + ;; we need now to see which entry is needed to start + ;; the problem + words-to-be-checked)) + + +(defun detect-first-starting-problematic-word (words-to-be-checked) + (let ((wtbc (cdr words-to-be-checked)) + (last-word (car words-to-be-checked))) + (do ((iadfa (gen-iadfa wtbc) (gen-iadfa wtbc))) + ((null wtbc)) + (if (equal wtbc + (extract-words (iadfa-fsa iadfa))) + (return (cons last-word wtbc))) + (setf last-word (car wtbc)) + (setf wtbc (cdr wtbc))))) + +(defun filter-non-problematic-words (words-to-be-checked) + (let ((problematics-words (list (car words-to-be-checked))) + (last-word (cadr words-to-be-checked)) + (words-to-be-checked (cddr words-to-be-checked))) + (do ((iadfa (gen-iadfa (append problematics-words words-to-be-checked)) + (gen-iadfa (append problematics-words words-to-be-checked)))) + ((null words-to-be-checked)) + (if (equal (append problematics-words words-to-be-checked) + (extract-words (iadfa-fsa iadfa))) + (setf problematics-words (nconc problematics-words (list last-word)))) + (setf last-word (car words-to-be-checked)) + (setf words-to-be-checked (cdr words-to-be-checked))) + (setf problematics-words (nconc problematics-words (list last-word))) + problematics-words)) + + +(defun detect-problems-from-file (filename) + (let ((words-to-be-checked nil)) + (let ((iadfa (build-iadfa))) + (for-each-line-in-file (word filename) + (setf words-to-be-checked (nconc words-to-be-checked (list word))) + (format t "Processing word [~A].~%" word) + (handle-word iadfa (concatenate 'list word)) + (when (not (equal words-to-be-checked + (extract-words (iadfa-fsa iadfa)))) + (format t "Word [~A] triggered a problem.~%" word) + (return)) + nil)) + ;; We got the first entry that trigger the problem. + ;; we need now to see which entry is needed to start + ;; the problem + (setf words-to-be-checked + (detect-first-starting-problematic-word words-to-be-checked)) + (setf words-to-be-checked + (filter-non-problematic-words words-to-be-checked)) + words-to-be-checked)) + + + + + ;; (defun dump-words (iadfa) ;; (let ((fsa (iadfa-fsa)) ;; (states (list (cons "" (fsa-start-node start))))) diff --git a/finenight/lisp/package.lisp b/finenight/lisp/package.lisp index 0360cfd..f2ab929 100644 --- a/finenight/lisp/package.lisp +++ b/finenight/lisp/package.lisp @@ -83,4 +83,6 @@ :iadfa-state-ancestrors :make-fsa-builder-from-fsa :nadd-edge - :transition)) + :transition + :detect-problems-from-file + :test-equivalence))