[Challenge] Comparer des listes hétérogènes

[VDH-Bruno]

Bonsoir,

 

Une petite idée de challenge m’a traversé l’esprit, le but serait de pouvoir comparer des listes constitués d’élément pouvant être de type différent, et ce indépendamment de leurs positions dans la liste.

 

Dans le principe si tous les éléments de la liste 1 sont présents dans la liste 2 et vice-versa, la fonction retourne T, ex :

(compare-p '(1 2 "abc" 2 (3.4 "d")) '(2 2 (3.4 "d") "abc" 1)) retourne T

Sinon la fonction retourne nil, ex :

(compare-p '(1 2 "abc" 2 (3.4 "d")) '(2 3 (3.4 "d") "abc" 1)) retourne nil

 

Bon code

[(gile)]

Salut,

 

Ma contribution :

 

(defun removeAt (i l)
 (if (or (zerop i) (null l))
   (cdr l)
   (cons (car l) (removeAt (1- i) (cdr l)))
 )
)

(defun contentEqual (l1 l2 / i)
 (or
   (and (null l1) (null l2))
   (and l1
 (setq i (vl-position (car l1) l2))
 (contentEqual (cdr l1) (removeAt i l2))
   )
 )
)

[VDH-Bruno]

Bonjour,

 

C'est du rapide je regarderai cela un peu plus dans le détail en soirée, j'attend encore pour donner ma version.

 

A+ Bruno

[(gile)]

La même pour les allergiques à la récursivité :

 

(defun removeAt	(i l / r)
 (while (and l (< 0 i))
   (setq r (cons (car l) r)
  l (cdr l)
  i (1- i)
   )
 )
 (append (reverse r) (cdr l))
)

(defun contentEqual (l1 l2 / p i)
 (setq p T)
 (while (and p l1)
   (if	(setq i (vl-position (car l1) l2))
     (setq l1 (cdr l1)
    l2 (removeAt i l2)
     )
     (setq p nil)
   )
 )
 (and p (null l2))
)

[VDH-Bruno]

Re,

 

Excellente contribution (gile), pour ma part je me suis orienté sur une solution plus basique..

(defun bv:contentEqual (a b / f)
 (defun f (a b c)
   (cond ((not (and a b )) (not (or a b )))
  ((equal (car a) (car b ) 1e-8) (f (cdr a) (append c (cdr b )) nil))
  (T (f a (cdr b ) (cons (car b ) c)))
   )
 )
 (f a b nil)
)

 

 

Solution dont j'ai cherché à optimisée le traitement, en supprimant l'appel à la fonction append.

(defun bv:contentEqual (a b / f g)
 (defun f (a b c)
   (cond ((not (and a b )) (not (or a b )))
  ((equal (car a) (car b ) 1e-8) (g (cdr a) (cdr b ) c))
  (T (f a (cdr b ) (cons (car b ) c)))
   )
 )
 (defun g (a b c)
   (cond ((null c) (f a b c))
  ((equal (car a) (car c) 1e-8) (g (cdr a) b (cdr c)))
  (T (g a (cons (car c) B) (cdr c)))
   )
 )
 (f a b nil)
)

 

A+

Ps: (gile) je t'ai pris l'appellation contentEqual , que je trouve beaucoup plus parlante, merci

[Patrick_35]

Salut

 

Ma contribution

(defun compare (a b / p s)
 (defun s(l p / B)
   (setq i 0)
   (while l
     (or (eq i p)
(setq b (cons (car l) B))
     )
     (setq l (cdr l)
    i (1+ i)
     )
   )
   b
 )

 (while (setq p (vl-position (car a) B))
   (setq b (s b p)
  a (cdr a)
   )
 )
 (if (or a B)
   nil
   T
 )
)

 

Une version améliorée

(defun compare (a b / p s)
 (defun s(l p / a B)
   (setq a (nth p l)
  b (vl-remove a l)
   )
   (repeat (- (length l) (length B) 1)
     (setq b (cons a B))
   )
   b
 )

 (while (setq p (vl-position (car a) B))
   (setq b (s b p)
  a (cdr a)
   )
 )
 (if (or a B)
   nil
   T
 )
)

 

@+

Modifié le 1 décembre 2014 par Patrick_35

[Patrick_35]

Et une autre plus courte

(defun compare(a B)
 (while (and a b (= (length a) (length B)))
   (setq b (vl-remove (car a) B)
  a (vl-remove (car a) a)
   )
 )
 (if (eq (length a) (length B))
   T
   nil
 )
)

 

Et une optimisation

(defun compare(a B)
 (while (and a b (= (length a) (length B)))
   (setq b (vl-remove (car a) B)
         a (vl-remove (car a) a)
   )
 )
 (eq (length a) (length B))
)

 

@+

[VDH-Bruno]

 

Et une optimisation

(defun compare(a B)
 (while (and a b (= (length a) (length B)))
   (setq b (vl-remove (car a) B)
         a (vl-remove (car a) a)
   )
 )
 (eq (length a) (length B))
)

 

 

Excellent Patrick_35 :), en plus d'être concise, ta dernière version semble la plus efficace "d'après mes tests" (même si je reste prudent dans les comparaisons entre fonctions).

 

Ps: si tu ajoutes un espace entre le B et la parenthèse tu pourra garder un b minuscule

[VDH-Bruno]

Bonjour,

Une petite en passant certainement pas la plus rapide, mais au moins la plus courte..

 

(defun bv:contentEqual (l m)
 (equal (vl-sort (mapcar 'vl-prin1-to-string l) '<) (vl-sort (mapcar 'vl-prin1-to-string m) '<))
)

[ElpanovEvgeniy]

my version:

(defun f (a B)
 (cond ((equal a B))
       ((not (= (length a) (length B))) nil)
       ((f (vl-remove (car a) a) (vl-remove (car a) B)))
 )
)

 

[Patrick_35]

my version:

(defun f (a B)
 (cond ((equal a B))
       ((not (= (length a) (length B))) nil)
       ((f (vl-remove (car a) a) (vl-remove (car a) B)))
 )
)

Hi

 

I don't have the habit of récusives, but great job :D

 

Make yourself scarce on this forum.

 

Thank you for your contribution.

 

@+

[VDH-Bruno]

Bonjour et merci de votre participation,

 

my version:

(defun f (a B)
 (cond ((equal a B))
       ((not (= (length a) (length B))) nil)
       ((f (vl-remove (car a) a) (vl-remove (car a) B)))
 )
)

 

C'est très bon, vous avez du l'écrire vite car je suis surpris que vous ayez préféré not = à /= ;)

 

Cordialement,

[ElpanovEvgeniy]

Yes, I wrote a few minutes...

[-Olivier-]

Bonjour,

Soyez indulgent pour ma première contribution à un chalenge. :D

(defun foo ( y ) (acad_strlsort (mapcar '(lambda (x) (vl-princ-to-string x)) y)))
(defun compare-p (a b )
 (equal (foo a) (foo b )))

 

Je m'aperçois qu'il y a des ressemblances avec certains codes.

 

Olivier