剪辑在多个Multislot中找到最常见的元素

Question

我试图在类型符号的多个Multislot条目中找到最常见的元素，但我似乎没有一种体面的方法来将这些多命令的内容提取到单个迭代。

=================================

(deftemplate chain "" 
   (multislot edge
      (type SYMBOL))
)

(assert (chain (edge a b c d e f g)))
(assert (chain (edge d e f g h k l)))
(assert (chain (edge e o p q r s f)))

(deffunction find_most_common_edge ()
   (bind ?edge (create$))
   (bind ?counted_edge (create$))
   (bind ?largest_count 0)
   (do-for-all-facts ((?s chain)) TRUE
      (loop-for-count (length$ ?s:edge) (?s1 (expand$ ?s:edge)) 
      (if (not (member$ ?s1 ?counted_edge))
         then
         (bind ?counted_edge (create$ ?s1 ?counted_edge))
         (bind ?count (length$ (find-all-facts ((?s2 chain)) (member$ ?s1 ?s2:edge))))
         (if (= ?count ?largest_count)
            then
            (bind ?edge (create$ ?s1 ?edge))
            else 
            (if (> ?count ?largest_count)
               then
               (bind ?largest_count ?count)
               (bind ?edge (create$ ?s1)))))))      
   (return ?edge))

Answer 1

使用函数：

         CLIPS (6.4 2/9/21)
CLIPS> 
(deftemplate chain
   (multislot edge (type SYMBOL)))
CLIPS> 
(deffacts start
   (chain (edge a b c d e f g))
   (chain (edge d e f g h k l))
   (chain (edge e o p q r s f)))
CLIPS> 
(deffunction get-all-edges ()
   (bind ?all-edges (create$))
   (do-for-all-facts ((?f chain)) TRUE
      (bind ?all-edges (create$ ?all-edges ?f:edge)))
   (return ?all-edges))
CLIPS>    
(deffunction count-edge (?e ?all-edges)
   (bind ?all-length (length$ ?all-edges))
   (return (- ?all-length (length$ (delete-member$ ?all-edges ?e)))))
CLIPS>    
(deffunction remove-duplicates ($?mf)
   (bind ?rv (create$))
   (foreach ?v ?mf
      (if (not (member$ ?v ?rv))
         then 
         (bind ?rv (create$ ?rv ?v))))
   (return ?rv))
CLIPS>      
(deffunction find-most-common-edge ()
   (bind ?all-edges (get-all-edges))
   (bind ?unique-edges (remove-duplicates ?all-edges))
   (bind ?largest-count 0)
   (bind ?most-common (create$))
   (foreach ?e ?unique-edges
      (bind ?count (count-edge ?e ?all-edges))
      (if (= ?count ?largest-count)
         then
         (bind ?most-common (create$ ?most-common ?e))
         else 
         (if (> ?count ?largest-count)
            then
            (bind ?largest-count ?count)
            (bind ?most-common (create$ ?e)))))
   (return ?most-common))
CLIPS> (reset)
CLIPS> (find-most-common-edge)
(e f)
CLIPS>

使用规则：

CLIPS> (clear)
CLIPS> 
(deftemplate chain
   (slot id (default-dynamic (gensym*)))
   (multislot edge (type SYMBOL)))
CLIPS> 
(deftemplate count
   (slot edge)
   (multislot ids))
CLIPS>    
(deffacts start
   (chain (edge a b c d e f g))
   (chain (edge d e f g h k l))
   (chain (edge e o p q r s f))
   (find-common-edge))
CLIPS> 
(defrule create-count
   (logical (find-common-edge))
   (chain (id ?id) (edge $? ?e $?))
   (not (count (edge ?e)))
   =>
   (assert (count (edge ?e) (ids ?id))))
CLIPS>    
(defrule add-to-count
   (logical (find-common-edge))
   (chain (id ?id) (edge $? ?e $?))
   ?f <- (count (edge ?e) (ids $?ids))
   (test (not (member$ ?id ?ids)))
   =>
   (modify ?f (ids ?ids ?id)))
CLIPS>    
(defrule most-common-edge
   (declare (salience -10))
   ?f <- (find-common-edge)
   (count (edge ?e) (ids $?r1))
   (not (and (count (edge ~?e) (ids $?r2))
             (test (> (length$ ?r2) (length$ ?r1)))))
   =>
   (bind ?length (length$ ?r1))
   (bind ?edges (create$))
   (do-for-all-facts ((?c count)) 
                     (eq (length$ ?c:ids) ?length)
      (bind ?edges (create$ ?edges ?c:edge)))
   (assert (most-common-edges ?edges))
   (retract ?f))
CLIPS> (reset)
CLIPS> (run)
CLIPS> (facts)
f-1     (chain (id gen4) (edge a b c d e f g))
f-2     (chain (id gen5) (edge d e f g h k l))
f-3     (chain (id gen6) (edge e o p q r s f))
f-20    (most-common-edges e f)
For a total of 4 facts.
CLIPS>