From 389f402364e1fd614549348ba3b73120e146f23c Mon Sep 17 00:00:00 2001 From: morioka Date: Tue, 26 Jan 1999 16:06:34 +0000 Subject: [PATCH] (mime-reduce-acting-situation-examples): New implementation. --- mime-play.el | 144 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 78 insertions(+), 66 deletions(-) diff --git a/mime-play.el b/mime-play.el index 6c00a38..acf8e94 100644 --- a/mime-play.el +++ b/mime-play.el @@ -64,73 +64,85 @@ (add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples) (defun mime-reduce-acting-situation-examples () - (let* ((rest mime-acting-situation-example-list) - (min-example (car rest)) - (min-score (cdr min-example))) - (while rest - (let* ((example (car rest)) - (score (cdr example))) - (cond ((< score min-score) - (setq min-score score - min-example example) - ) - ((= score min-score) - (if (<= (length (car example))(length (car min-example))) - (setq min-example example) - )) - )) - (setq rest (cdr rest))) - (setq mime-acting-situation-example-list - (delq min-example mime-acting-situation-example-list)) - (setq min-example (car min-example)) - (let ((examples mime-acting-situation-example-list) - (max-score 0) - max-examples) - (while examples - (let* ((ret (mime-compare-situation-with-example min-example - (caar examples))) - (ret-score (car ret))) - (cond ((> ret-score max-score) - (setq max-score ret-score - max-examples (list (cdr ret))) + (let ((len (length mime-acting-situation-example-list)) + i ir ic j jr jc ret + dest d-i d-j + (max-sim 0) sim + min-det-ret det-ret + min-det-org det-org + min-freq freq) + (setq i 0 + ir mime-acting-situation-example-list) + (while (< i len) + (setq ic (car ir) + j 0 + jr mime-acting-situation-example-list) + (while (< j len) + (unless (= i j) + (setq jc (car jr)) + (setq ret (mime-compare-situation-with-example (car ic)(car jc)) + sim (car ret) + det-ret (+ (length (car ic))(length (car jc))) + det-org (length (cdr ret)) + freq (+ (cdr ic)(cdr jc))) + (cond ((< max-sim sim) + (setq max-sim sim + min-det-ret det-ret + min-det-org det-org + min-freq freq + d-i i + d-j j + dest (cons (cdr ret) freq)) ) - ((= ret-score max-score) - (setq max-examples (cons (cdr ret) max-examples)) - ))) - (setq examples (cdr examples))) - (while max-examples - (let* ((example (car max-examples)) - (cell (assoc example mime-acting-situation-example-list))) - (if cell - (setcdr cell (1+ (cdr cell))) - (setq mime-acting-situation-example-list - (cons (cons example 0) - mime-acting-situation-example-list)) - )) - (setq max-examples (cdr max-examples)) - )))) - - -;;; @ content decoder -;;; - -(defun mime-preview-play-current-entity (&optional ignore-examples mode) - "Play current entity. -It decodes current entity to call internal or external method. The -method is selected from variable `mime-acting-condition'. -If IGNORE-EXAMPLES (C-u prefix) is specified, this function ignores -`mime-acting-situation-example-list'. -If MODE is specified, play as it. Default MODE is \"play\"." - (interactive "P") - (let ((entity (get-text-property (point) 'mime-view-entity))) - (if entity - (let ((situation (list (cons 'mode (or mode "play"))))) - (if ignore-examples - (setq situation - (cons (cons 'ignore-examples ignore-examples) - situation))) - (mime-play-entity entity situation) - )))) + ((= max-sim sim) + (cond ((> min-det-ret det-ret) + (setq min-det-ret det-ret + min-det-org det-org + min-freq freq + d-i i + d-j j + dest (cons (cdr ret) freq)) + ) + ((= min-det-ret det-ret) + (cond ((> min-det-org det-org) + (setq min-det-org det-org + min-freq freq + d-i i + d-j j + dest (cons (cdr ret) freq)) + ) + ((= min-det-org det-org) + (cond ((> min-freq freq) + (setq min-freq freq + d-i i + d-j j + dest (cons (cdr ret) freq)) + )) + )) + )) + )) + ) + (setq jr (cdr jr) + j (1+ j))) + (setq ir (cdr ir) + i (1+ i))) + (if (> d-i d-j) + (setq i d-i + d-i d-j + d-j i)) + (setq j-r (nthcdr (1- d-j) mime-acting-situation-example-list)) + (setcdr j-r (cddr j-r)) + (if (= d-i 0) + (setq mime-acting-situation-example-list + (cdr mime-acting-situation-example-list)) + (setq i-r (nthcdr (1- d-i) mime-acting-situation-example-list)) + (setcdr i-r (cddr i-r)) + ) + (if (setq i-r (assoc (car dest) mime-acting-situation-example-list)) + (setcdr i-r (+ (cdr i-r)(cdr dest))) + (setq mime-acting-situation-example-list + (cons dest mime-acting-situation-example-list)) + ))) (defun mime-sort-situation (situation) (sort situation -- 1.7.10.4