diff --git a/finenight/lisp/iadfa-test.lisp b/finenight/lisp/iadfa-test.lisp index 05ad7e7..409b96f 100644 --- a/finenight/lisp/iadfa-test.lisp +++ b/finenight/lisp/iadfa-test.lisp @@ -64,6 +64,7 @@ (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)) @@ -214,49 +215,18 @@ produce a stem shorter than the previous stem. :test-fn #'iadfa-test12) (defun iadfa-test13 () - "The 0-5000 was created." - (test-equivalence '("0-1000000" - "0-10000000" - "0-3" - "0-3-0" - "0-3-6" - "0-30" - "0-300" - "0-3000" - "0-300MPH" - "0-50" + "The 0-5000 was created. This was caused by the common +prefix node of 0-3000 and 0-300MPH forgot to remove the +ancestror of the node created for the subsubed previous +stem" + (test-equivalence '("0-1000000" + "0-10000000" + "0-300" + "0-3000" + "0-300MPH" "0-500" "0-500MPH"))) -(defun iadfa-test13 () - (test-equivalence '("0-1000000" "0-10000000" "0-10000HIT" "0-1000ADULTTOYSSEXTOYS" "0-1000HIT" - "0-100ADOLESCENT18" "0-100C" "0-100EDU" "0-100KM" "0-100SPORTS" "0-101" - "0-101---0-1-2-3-4-5-6-7-8-9-DECLARATION-OF-WAR--MERCURYDOLPHIN" - "0-10EISAI" "0-11" "0-110" "0-111" "0-117" "0-12" "0-123" "0-123-456-789" - "0-123456789" "0-12CLUB" "0-12KIDS" "0-12LINEMEN" "0-13" "0-1320FEET" - "0-14" "0-15" "0-16" "0-160" "0-168" "0-16EDU" "0-173" "0-18" "0-180" - "0-18SOS" "0-18SUI" "0-18TEENS4U" "0-19BOYS" "0-1AND1-0" "0-1AVSEX" "0-1DU" - "0-1KISS" "0-1MEDIA" "0-1NET" "0-1SEX" "0-1SHOP" "0-1TECH" "0-1WEB" - "0-1XXX" "0-2" "0-2-0" "0-2-1" "0-2-60" "0-2-7" - "0-2-AMATEUR-XXX-GAY-LESBIAN-ADULT-VIDEOS" "0-2-GENION" "0-2-ONLINE" "0-20" - "0-200" "0-2000" "0-200MPH" "0-21" "0-212" "0-216" "0-21SMARTKIDS" "0-22" - "0-23" "0-232" "0-24" "0-24-SEX" "0-24AUTO" "0-24BUSINESS" "0-24FLORIST" - "0-24H" "0-24H-ZARSZERVIZ" "0-24JEWELRY" "0-24SEX" "0-24SHOP" - "0-24SHOPPING" "0-24UHR" "0-25" "0-255" "0-261" "0-27" "0-273" "0-28" - "0-29" "0-2FLO-WERS" "0-2GENION" "0-2GO" "0-2K" "0-2TALENT" "0-2TALENTS" - "0-2U" "0-2VISA" "0-3" "0-3-0" "0-3-6" "0-3-6AIBB" "0-30" "0-300" "0-3000" - "0-300MPH" "0-312" "0-34" "0-36" "0-360" "0-360C" "0-360CARDS" - "0-360FINANCIAL" "0-360HOLDINGS" "0-360HOMES" "0-360HOMETOURS" "0-360MLS" - "0-360PHOTO" "0-360PHOTOS" "0-360PHOTOTOURS" "0-360PODCASTNEWS" - "0-360REALTY" "0-360RESORTS" "0-360TOUR" "0-360TOURS" "0-360VIEWS" - "0-360VR" "0-365" "0-371" "0-3BABY" "0-3D" "0-3FORUM" "0-3YEARS" "0-4" - "0-4-0" "0-40" "0-400KM" "0-400M" "0-400MPH" "0-41" "0-411" "0-45" "0-462" - "0-48" "0-49" "0-4D" "0-4FACTORY" "0-4VADUZ" "0-5" "0-5-0" "0-5-30" "0-50" - "0-500" "0-500MPH"))) - -(iadfa-test13) - - (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 71fa5ae..c66a2f3 100644 --- a/finenight/lisp/iadfa.lisp +++ b/finenight/lisp/iadfa.lisp @@ -214,19 +214,21 @@ (reduce #'(lambda (iadfa input) (let ((new-node (get-fresh-node iadfa))) (setf (node-final new-node) (car profile)) + (setf profile (cdr profile)) + (iadfa-add-edge! iadfa last-node input new-node) (when sub-prefix (when (= 1 (length sub-prefix)) - (iadfa-add-edge! iadfa last-node (car sub-prefix) sub-node)) + (iadfa-add-edge! iadfa last-node (car sub-prefix) sub-node) + (remove-ancestror-to-childs iadfa last-node)) (setf sub-prefix (cdr sub-prefix))) - (setf profile (cdr profile)) - (iadfa-add-edge! iadfa last-node input new-node) (setf last-node new-node) iadfa)) processing-stem :initial-value iadfa) (iadfa-add-edge! iadfa last-node last-input suffix-node) (when (= 1 (length sub-prefix)) - (iadfa-add-edge! iadfa last-node (car sub-prefix) sub-node)) + (iadfa-add-edge! iadfa last-node (car sub-prefix) sub-node) + (remove-ancestror-to-childs iadfa last-node)) iadfa))