Challenge 34 (liste de substitution)

[VDH-Bruno]

Bonsoir,

 

Voilà en corrigeant une coquille dans une de mes routines, j’ai pensé que la routine en question pourrait faire l’objet d’un petit challenge pas trop compliqué de début d’année.

 

Il s’agit simplement d’émuler un peu la fonction subst de façon à ce que cette nouvelle version ne travaille plus sur un seul élément à remplacer, mais sur un ensemble d’éléments fourni sous forme de liste.

 

Syntaxe

(lsubst lst-nouv-élemt lst-anc-élemt lst)

 

Arguments

lst-nouv-élemt: Liste des nouveaux éléments

lst-anc-élemt : Liste des anciens éléments

lst : Liste de réference

 

Valeur en retour

Une liste modifié ou les nouveaux éléments remplacent les anciens, la liste est inchangée pour les éléments introuvablent

 

Quelques exemples de résultats attendus:

(lsubst '(x y z) '(a c e) '(a b c d c))        retourne  (X B Y D Y)    
(lsubst '(b c nil) '(c b a) '(a b c d c))        retourne  (nil C B D B)
(lsubst '(b c) '(c b a) '(a b c d c))        retourne  (A C B D B)
(lsubst '(b c d) '(c B) '(a b c d c))        retourne  (A C B D B)
(lsubst '(z y w) '(a b c) '(a b c d c))        retourne  (Z Y W D W)
(lsubst '(b c a) '(a b c) '(a b c d c))        retourne  (B C A D A)

 

En espérant avoir été suffisamment explicite, sinon ne pas hésiter à demander un complément d’information.

 

A+

[bryce]

Bonjour,

 

Une proposition:

 

(defun lsubst ( l1 l2 liste / )
 (mapcar
   '(lambda (x / i)
     (if (setq i (vl-position x l2))
       (if (< i (length l1))
         (nth i l1)
         x
       )
       x
     )
   )
   liste
 )
)

[Patrick_35]

Salut

 

La mienne qui ressemble beaucoup à celle de bryce

 

(defun lsubst (new old lst)
 (mapcar '(lambda(a / B) (if (and (setq b (vl-position a old))
			   (< b (length new))
		      )
		    (nth b new)
		    a
		  )
  )
  lst
 )
)

 

Et une autre sans la fonction vl-position

(defun lsubst (new old lst)
 (mapcar '(lambda(a / B) (if (and (member a old)
			   (< (setq b (- (length old) (length (member a old)))) (length new))
		      )
		    (nth b new)
		    a
		  )
  )
  lst
 )
)

 

@+

[VDH-Bruno]

Bonjour,

 

Très heureux de voir qu’il a des participants, mention à vous deux, même si je m’attendais à voir surgir les réponses avec vl-position. Je saluts l’effort de Patrick_35 pour sa variante avec member.

 

Pour ma part j’avais tenté une autre approche plus évidente que j’aurais cru plus efficace (sans l’utilisation de vl-position), mais cela n’a pas été le cas..

 

En récursion enveloppante

(defun lsubst (newlst oldlst lst / fun)

 (defun fun (new old lst)
   (if	(and new old)
     (subst (car new) (car old) (fun (cdr new) (cdr old) lst))
     lst
   )
 )

 (mapcar 'car
  (fun
    (mapcar 'list newlst oldlst)
    (mapcar 'list oldlst oldlst)
    (mapcar 'list lst lst)
  )
 )
 
)

 

En récursion terminale

(defun lsubst (newlst oldlst lst / fun)

 (defun fun (new old lst)
   (if	(and new old)
     (fun (cdr new) (cdr old) (subst (car new) (car old) lst))
     lst
   )
 )

 (mapcar 'car
  (fun
    (mapcar 'list newlst oldlst)
    (mapcar 'list oldlst oldlst)
    (mapcar 'list lst lst)
  )
 )
 
)

 

Et comme la forme récursive ne se justifie pas du tout

En version itérative

(defun bv:lsubst (newlst oldlst lst)

 (setq	newlst (mapcar 'list newlst oldlst)
oldlst (mapcar 'list oldlst oldlst)
lst    (mapcar 'list lst lst)
 )

 (while (and newlst oldlst)
   (setq lst	 (subst (car newlst) (car oldlst) lst)
  newlst (cdr newlst)
  oldlst (cdr oldlst)
   )
 )

 (mapcar 'car lst)
)

 

 

Allez hop! Un petit coup de benchmark

(benchmark '((bv:lsubst '(b c d) '(c B) '(a b c d c b c a d c))
     (bryce:lsubst '(b c d) '(c B) '(a b c d c b c a d c))
     (Patrick1:lsubst '(b c d) '(c B) '(a b c d c b c a d c))
     (Patrick2:lsubst '(b c d) '(c B) '(a b c d c b c a d c))
    )
)

 

Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):

(PATRICK1:LSUBST (QUOTE (B C D)) (QU...).....1030 / 1.35 <fastest>

(BRYCE:LSUBST (QUOTE (B C D)) (QUOTE...).....1061 / 1.31

(PATRICK2:LSUBST (QUOTE (B C D)) (QU...).....1264 / 1.1

(BV:LSUBST (QUOTE (B C D)) (QUOTE (C...).....1388 / 1 <slowest>

 

 

Dans l’attente d’autres solutions, pendant ce temps je regarde si il y a moyen de faire mieux mais cela me semble difficile, à voir..

[ElpanovEvgeniy]

Bonjour,

 

ma version:

 

(defun ee:f (n o l)
 (setq n (mapcar (function cons) o n))
 (mapcar (function (lambda (a)
                     (cond ((cdr (assoc a n)))
                           (a)
                     )
                   )
         )
         l
 )
)

 

 

[Tramber]

...ça énerve, hein ?

Moi je ne joue pas, je suis trop nul et souvent trop long.

 

Bonne Année, Evgeniy !

 

Un petit bench' ?

[(gile)]

Salut,

 

J'avais la même que Patrick_35 (avec vl-position).

J'avais aussi essayé avec assoc comme Evgeniy, mais ça ne fonctionne pas avec :

(lsubst '(b c nil) '(c b a) '(a b c d c))

[ElpanovEvgeniy]

Salut,

 

J'avais la même que Patrick_35 (avec vl-position).

J'avais aussi essayé avec assoc comme Evgeniy, mais ça ne fonctionne pas avec :

(lsubst '(b c nil) '(c b a) '(a b c d c))

 

Merci, (gile)!

La nouvelle version:

 

 

(defun f (n o l)
 (setq n (mapcar (function cons) o n))
 (mapcar (function (lambda (a / B)
                     (cond ((setq b (assoc a n)) (cdr B))
                           (a)
                     )
                   )
         )
         l
 )
)

[VDH-Bruno]

Bonsoir,

 

J’ai rallumé mon micro trop tard, EpanovEvgeniy a été plus rapide pour la variante avec assoc, je le félicite (Я поздравляю)!!!

Lorsque je vous ai lu j’étais comme (gile), il me fallait encore affiner le (lsubst '(b c nil) '(c b a) '(a b c d c)).

 

Mon code, c’est sans regret j’étais de toutes façons moins efficace avec une liste au lieu d’une paire pointée.

(defun bv:lsubst (new old lst / old-new)
 (setq old-new (mapcar 'list old new))
 (mapcar '(lambda (x / y) (cond ((setq y (assoc x old-new)) (cadr y)) (x))) lst)
) 

 

Pour la forme et faire plaisir à Tramber un petit Benchmark

(benchmark
 (mapcar '(lambda (fun)(list fun ''(b c d) ''(c B) ''(a b c d c b c a d c)))
  '(bryce:lsubst Patrick:lsubst ElpanovEvgeniy:lsubst bv:lsubst)
 ) 
)

 

Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):

(PATRICK:LSUBST (QUOTE (B C D)) (QUO...).....1282 / 1.04 <fastest>

(BRYCE:LSUBST (QUOTE (B C D)) (QUOTE...).....1296 / 1.02

(ELPANOVEVGENIY:LSUBST (QUOTE (B C D...).....1313 / 1.01

(BV:LSUBST (QUOTE (B C D)) (QUOTE (C...).....1328 / 1 <slowest>

 

(Ps: Pourquoi utiliser function car malgré plusieurs tests, à ce jour je n'ai jamais réussi à percevoir son intéret..)

 

A+

[ElpanovEvgeniy]

as Patrick_35

 

(defun f (n o l / i)
 (setq i (length n))
 (mapcar (function (lambda (a / B)
                     (if (and (setq b (vl-position a o)) (< b i))
                       (nth b n)
                       a
                     )
                   )
         )
         l
 )
)

[ElpanovEvgeniy]

Je pense qu'il est intéressant d'essayer une longue liste de:

 

test1

(setq new '(1 2 3 4)
     old '(4 3 2 1)
     lst '(3 1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2
           8 8 4 1 9 7 1 6 9 3 9 9 3 7 5 1 0 5 8 2 0 9 7 4 9 4 4 5 9 2 3 0 7 8
           1 6 4 0 6 2 8 6 2 0 8 9 9 8 6 2 8 0 3 4 8 2 5 3 4 2 1 1 7 0 6 7 9
           )
)

 

 

test2

(setq new '(q w e r y u i o p a s d f g h j k l z x c v b n m q w e r y u i o p
           q w e r y u i o p a s d f g h j k l z x c v b n m q w e r y u i o p
           q w e r y u i o p a s d f g h j k l z x c v b n m q w e r y u i o 
           )
     old '(3 1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2
           8 8 4 1 9 7 1 6 9 3 9 9 3 7 5 1 0 5 8 2 0 9 7 4 9 4 4 5 9 2 3 0 7 8
           1 6 4 0 6 2 8 6 2 0 8 9 9 8 6 2 8 0 3 4 8 2 5 3 4 2 1 1 7 0 6 7 9
           )
     lst '(1 2 3 4)
)

 

 

test3

(setq new '(q w e r y u i o p a s d f g h j k l z x c v b n m q w e r y u i o p
           q w e r y u i o p a s d f g h j k l z x c v b n m q w e r y u i o p
           q w e r y u i o p a s d f g h j k l z x c v b n m q w e r y u i o 
           )
     old '(3 1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2
           8 8 4 1 9 7 1 6 9 3 9 9 3 7 5 1 0 5 8 2 0 9 7 4 9 4 4 5 9 2 3 0 7 8
           1 6 4 0 6 2 8 6 2 0 8 9 9 8 6 2 8 0 3 4 8 2 5 3 4 2 1 1 7 0 6 7 9
           )
     lst '(3 1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2
           8 8 4 1 9 7 1 6 9 3 9 9 3 7 5 1 0 5 8 2 0 9 7 4 9 4 4 5 9 2 3 0 7 8
           1 6 4 0 6 2 8 6 2 0 8 9 9 8 6 2 8 0 3 4 8 2 5 3 4 2 1 1 7 0 6 7 9
           )
)

[VDH-Bruno]

Bonjour,

Sur le même algorithme que ma réponse n°4 mais en bouclant cette fois avec mapcar..

 

(defun bv:lsubst (newlst oldlst lst)
 (setq  lst (mapcar 'cons lst lst))  
 (mapcar '(lambda (n o) (setq lst (subst n o lst)))
  (mapcar 'cons newlst oldlst)
  (mapcar 'cons oldlst oldlst)
 )
 (mapcar 'car lst)
)

 

 

Pour les testes sur les longues listes je suis d'accord avec vous Evgeniy. Comme je ne l'ai pas fait j'ai donné un teste qui donnait tout le monde gagnant.. Pour bien faire il faudrait même faire varier le nombre d’éléments identiques, car la version avec subst travaille différemment des autres versions.

 

Для испытаний на длинный список я согласен с вами, Evgeniy. Поскольку я не я дал тест, который дал каждому победителю .. В идеале она должна быть еще варьировать количество одинаковых элементов, так как версия с subst работает иначе, чем в других версиях.

 

Cordialement

 

(Modifié code en remplaçant 'list par 'cons)

Modifié le 7 janvier 2012 par VDH-Bruno

[VDH-Bruno]

Re,

 

Pour Evgeniy, j’ai regardé les testes proposés je pense que pour test2 et test3 la répétition des éléments identiques dans new et old n’a pas de sens cela devrait être contrôlé en amont.

 

Для Evgeniy, я посмотрел на предлагаемые испытания Я думаю, для test2 и test3 повторение одинаковых элементов в new и old не имеет смысла, она должна быть проверена заранее.

 

 

--------------------------------

 

J’édite mon message pour diffuser les résultats des évaluations Benchmark

 

En ce qui concerne les codes proposés, ils sont de trois types ceux construit avec vl-position (et member qui utilise le même algorithme), subst et assoc.

Pour les comparer et les soumettre au teste du Benchmark, j’ai gardé la version la plus optimisée pour chaque famille d’algorithme à savoir :

 

Avec assoc

J’ai retenu le code donné par ElpanovEvgeniy réponse n°8

 

Pour vl-position

Code donné par Patrick_35 et bryce puis optimisé par ElpanovEvgeniy réponse n°10

 

Pour subst

La version que je propose en réponse n°12

 

 

Les résultats des évaluations donnés au Benchmark le sont pour les valeurs proposées en réponse n°11

 

(benchmark 
 (mapcar '(lambda (fun)(list fun 'new 'old 'lst)) 
         '(lsubst:assoc lsubst:vl-position lsubst:subst) 
 )  
)

 

 

Teste1

Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

(LSUBST:ASSOC NEW OLD LST)...........1390 / 1.88 <fastest>

(LSUBST:VL-POSITION NEW OLD LST).....1390 / 1.88

(LSUBST:SUBST NEW OLD LST)...........2609 / 1 <slowest>

 

Teste 2

Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):

(LSUBST:VL-POSITION NEW OLD LST).....1016 / 6.8 <fastest>

(LSUBST:ASSOC NEW OLD LST)...........1578 / 4.38

(LSUBST:SUBST NEW OLD LST)...........6906 / 1 <slowest>

 

Teste 3

Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

(LSUBST:ASSOC NEW OLD LST)............1922 / 21.47 <fastest>

(LSUBST:VL-POSITION NEW OLD LST)......1969 / 20.96

(LSUBST:SUBST NEW OLD LST)...........41265 / 1 <slowest>

 

A+

Modifié le 7 janvier 2012 par VDH-Bruno

[VDH-Bruno]

Bonjour,

 

Allez une dernière petite variante de lsubst , certes ce n’est pas la version la plus performante mais c’est sans l’utilisation de vl-position, member, subst, assoc et autres fonctions spécialisées…

 

(defun lsubst (n o l)
 (mapcar '(lambda (l / x)
     (mapcar '(lambda (n o) (if (equal o l) (setq x (list n))))
	     n
	     o
     )
     (if x (car x) l)
   )
  l
 )
)

 

A+