assoc complet

[Bred]

Salut,

je viens de faire ça, c'est pas compliqué mais ça peut-être utile je pense :

(et si vous avez "plus beau...)

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Assoc sur tous les éléments des sous-listes				;
; -> (assoc-full "U" (list '(1 "U" 4) '(6 8 "U") '(5 2 8)))= ((1 "U" 4) (6 8 "U"));

(defun assoc-full (el lst / x)
 (foreach n lst (if (member el n) (setq x (append x (list n)))))
 x 
)

[Bred]

... j'en avais un autre mais je n'arrive pas à enlever la valeur nil de la liste....

 

(defun assoc-full (el lst /)
 (mapcar '(lambda (x) (if (member el x) x)) lst)   
)

 

(assoc-full "U" (list '(1 "U" 4) '(6 8 "U") '(5 2 8))) = ((1 "U" 4) (6 8 "U") nil)

 

[(gile)]

Salut,

 

une ruse avec append et les listes vide (nil)

 

(defun assoc-full (el lst /)
(apply 'append (mapcar '(lambda (x) (if (member el x) (list  x))) lst)   
)

[Bred]

... merci, mais il y a plus simple en fait :

 

(defun assoc-full (el lst / x)
 (vl-remove-if '(lambda (x) (not (member el x))) lst)    
)

[Bred]

... ah, zut, je coince.

ça ne fonctionne pas si il y a des paires pointés...

 

(member "U"  (cons 1 "U"))

= erreur....

 

[VDH-Bruno]

Bonsoir Bred,

 

Ton code m’a beaucoup intéressé, je te propose juste une idée comme ça, histoire d’avoir une autre approche.. en déstructurant les paires pointés ça te conviendrai pas ?

 

Pour déstructurer les paires pointées contenues dans une liste.

 

(setq li (list '(1 "U" 4) '(6 8 "U") '(5 2 8) '(1 . "U")))

;; Variante n°1
;;  déstructure  les paires pointés contenues dans une liste
(mapcar	'(lambda (x)
   (if (listp (cdr x))
     x
     (list (car x) (cdr x))
   ) ;_ Fin de if
 ) ;_ Fin de lambda
li
) ;_ Fin de mapcar

;; Variante n°2
;;  déstructure  les paires pointés contenues dans une liste
(mapcar	'(lambda (x)
   (if (atom (cdr x))
     (list (car x) (cdr x))
     x
   ) ;_ Fin de if
 ) ;_ Fin de lambda
li
) ;_ Fin de mapcar

 

Retourne

((1 "U" 4) (6 8 "U") (5 2 8) (1 "U"))

_$

 

En intégrant l’expression à ton code:

(defun assoc-full (el lst / )
 (vl-remove-if
   '(lambda (x) (not (member el x)))
   (mapcar '(lambda (x)
       (if (listp (cdr x))
	 x
	 (list (car x) (cdr x))
       ) ;_ Fin de if
     ) ;_ Fin de lambda
    lst
   ) ;_ Fin de mapcar
 ) ;_ Fin de vl-remove-if
) ;_ Fin de defun

 

Teste:

(setq e "U")
(setq li (list '(1 "U" 4) '(6 8 "U") '(5 2 8) '(1 . "U")))
(assoc-full e li)

 

Retourne:

((1 "U" 4) (6 8 "U") (1 "U"))

_$

 

Si le fait de ne pas retrouver ta paire pointé en retour et génant, il est toujours possible d’effectuer l’opération symétrique.

(code un peu plus délicat car il crée automatique une paire pointé sur toute les listes paires)

 

(setq li (list '(1 "U" 4) '(6 8 "U") '(5 2 8) '(1 "U")))

;; Reconstruire les paires pointées
(mapcar	'(lambda (x)
   (if (= (length x) 2)
     (cons (car x) (cadr x))
     x
   ) ;_ Fin de if
 ) ;_ Fin de lambda
li
) ;_ Fin de mapcar

 

Retourne

((1 "U" 4) (6 8 "U") (5 2 8) (1 . "U"))

_$

 

En intégrant de nouveau à ta fonction cela pourrait s’écrire :

 

 (defun assoc-full (el lst / )
 (mapcar '(lambda (x)
     (if (= (length x) 2)
       (cons (car x) (cadr x))
       x
     ) ;_ Fin de if
   ) ;_ Fin de lambda
  (vl-remove-if
    '(lambda (x) (not (member el x)))
    (mapcar '(lambda (x)
	       (if (listp (cdr x))
		 x
		 (list (car x) (cdr x))
	       ) ;_ Fin de if
	     ) ;_ Fin de lambda
	    lst
    ) ;_ Fin de mapcar
  ) ;_ Fin de vl-remove-if
 ) ;_ Fin de mapcar
) ;_ Fin de defun

 

Teste:

(setq e "U")
(setq li (list '(1 "U" 4) '(6 8 "U") '(5 2 8) '(1 . "U")))
(assoc-full e li)

 

Retourne:

((1 "U" 4) (6 8 "U") (1 . "U"))

_$

 

J’ai pas testé en profondeur, je l’ai un peu tapé à la volé, si ça te convient je te fait confiance pour trouver d’éventuel optimisation..

 

Par contre c’est vrai que vu comme cela le code perd un peu de son élégance, mais pour l’instant ça à l’air de fonctionner…

 

Cordialement

VDH

 

Edit: Oupss il n'est pas nécessaire de déclarer x comme variable dans assoc-full car c'est l'argument de fonctions lambda et non une variable, je corrige les codes.

 

 

 

 

[Edité le 21/10/2010 par VDH-Bruno]

[Bred]

Salut,

Merci pour l'idée, c'est en effet une solution.

[(gile)]

Salut,

 

Je propose une solution qui fonctionne avec les listes et paires pointées (mais j'ai du mal à voir l'utilité d'une telle fonction).

Je l'ai nommée remove-if-has-not parce que je n'aime pas trop l'idée d'utiliser assoc dans le nom de la routine. assoc fait référence à une liste d'association donc au car des listes ou paires pointées contenues dans cette liste*.

 

On trouve de nombreuses versions d'une fonction très souvent nommée massoc qui retourne la liste de toutes les entrées (ou de toutes les valeurs de ces entrées) de même car d'une liste d'association. L'utilisation de assoc dans le nom de la routine est alors beaucoup plus justifié.

 

(defun remove-if-has-not (ele lst)
 (vl-remove-if-not
   '(lambda (x)
      (or (and (atom (cdr x)) (= (cdr x) ele))
      (vl-position ele x)
      )
    )
   lst
 )
)

 

* fondamentalement, ce qu'on appelle liste en LISP est en fait une imbrication de 'cellules cons'. Une paire pointée étant une 'cellule cons' dont la 'queue' (cdr) est un atome.

[Bred]

Salut,

merci (gile), et tu as raison d'être pointilleux sur le vocabulaire, c'est plus parlant.

 

Bravo pour la routin, et le test de la paire pointé est tellement simple que je m'en veux de ne pas y avoir pensé !

(or (and (atom (cdr x)) (= (cdr x) ele))

 

Encore merci à tous.