Challenge 28

[(gile)]

Salut,

 

Ça fait longtemps qu'il n'y en pas eu, alors j'en propose un pas trop difficile.

 

Il s'agit de faire une routine qui retourne la position d'une suite d'éléments dans une liste.

 

Exemples :

 

_$ (position '(3 1) '(3 1 3 3 4 2 1))

0

_$ (position '(4 2 1) '(3 1 3 3 4 2 1))

4

_$ (position '(4 1) '(3 1 3 3 4 2 1))

nil

[ElpanovEvgeniy]

Salut (gile)!

 

Tu connais, j'aime tels sujets... :)

Quand, je peux publier la décision ?

 

[Edité le 10/10/2009 par ElpanovEvgeniy]

[(gile)]

Salut Evgeniy,

 

L'exercice n'est pas très difficile (pour toi).

Il faudrait attendre que d'autres répondent...

[ElpanovEvgeniy]

Bien, j'attends d'autres réponses.

[Tramber]

Je joue parce que c'est vous mais j'ai humblement échoué :

 

(defun position (test nlst / compt)
   (setq compt 0 preml nlst)
   (while(not(vl-every '= test nlst))(setq nlst(cdr nlst)compt(1+ compt)))
   (if(vl-some '= test nlst)compt))

 

Je ne suis pas trés doué pour la récursivité et la concision mais au moins ca marche. enfin ca a l'air.

[(gile)]

Petite précision

 

(position '(2 1 3) '(3 1 3 3 4 2 1)) devrait retourner nil.

[Tramber]

Voilà qui me met vraiment sur la piste :cool:

Je recois ce soir. J'ai usé mon temps max qui était une vingtaine de minutes.

 

Je venais juste voir les réponses car je donne ma langue au chat....

....mais attendons le début la semaine prochaine ?!

Si j'ai une idée demain :cool:

[Patrick_35]

Bonjour à vous tous

 

Je vais attendre un peu aussi

 

Tramber, converti la liste ;)

 

@+

[Tramber]

Gile m'a dit que j'étais pas loin du résultat. Ma seule erreur est que (position '(2 1 3) '(3 1 3 3 4 2 1)) n'est pas bon.

 

Tramber, converti la liste

 

?

[Patrick_35]

Tramber

 

en mp, sinon je donne la réponse ;)

 

@+

[Tramber]

Hop, vas-y Patrick.

Si tu as la meilleure réponse, tu peux y aller.

 

 

Y a un voyage à Marseille à gagner ! :D

[Patrick_35]

Avec un pastis sur le port :D

 

(defun position (pos lst)
 (vl-string-search (vl-list->string pos) (vl-list->string lst))
)

 

@+

[ElpanovEvgeniy]

Avec un pastis sur le port :D

 

(defun position (pos lst)
 (vl-string-search (vl-list->string pos) (vl-list->string lst))
)

 

@+

 

Une décision très intéressante!

Ma voie - propre LISP...

[bseb67]

Avec un pastis sur le port :D

 

(defun position (pos lst)
 (vl-string-search (vl-list->string pos) (vl-list->string lst))
)

 

@+

 

Une ligne, donc un seul pastis ;)

 

ma fonction est plus longue en code et plus lente...

[Tramber]

Au moins ma fonction fonctionne avec

 

(position '(3 1) '(3 1 3 3 4 200000 1))

 

La votre ? Bof, pas très bien :cool:

[bseb67]

Moi oui :D

 

aller hop je la met, mais comme dit, elle n'est pas des plus courtes:

;-------------------------------------;
; nom: position_bseb67                ;
; role: renvoie la position à laquelle;
;       se trouve la sous-liste slst  ;
;       dans la liste lst             ;
; param: slst => liste d'entiers      ;
;        lst => liste d'entiers       ;
; retour: un entier >= 0              ;
;         nil si pas trouvée          ;
; date: 12/10/2009                    ;
; BLAES Sébastien                     ;
;-------------------------------------;
(defun position_bseb67( slst lst / res position cpt tmp)
 	(setq res nil)
 
 	(cond
  	; on teste si le nombre d'élément dans lst est >= à celui dans slst
  	((< (length lst) (length slst))
	 	; impossible de trouver X éléments dans au plus X-1 éléments
	)
	
	; on cherche la position du premier élément de slst
	((/= (setq position (vl-position (car slst) lst)) nil)
	 	(setq res t
		      cpt 1)

	 	; on compare les éléments un par un
	 	(repeat (1- (length slst))
			(setq res (and res (= (nth cpt slst) (nth (+ cpt position) lst)))
			      cpt (1+ cpt))
		)

	 	(cond
		  	((= res t)
			 	; les éléments sont concordants
			 	(setq res position)
			)

			((= res nil)
			 	; on construit la liste temporaire
			 	(setq tmp lst)
				(repeat (1+ position)
				 	(setq tmp (cdr tmp))
				)
			 
			 	; on relance, mais sur les éléments après position dans lst
			 	(if (/= (setq res (position_bseb67 slst tmp)) nil)
				  	(setq res (+ res position 1))	
				) ; if
			)
		) ; cond
	)

	(t
	  	; le premier élément n'existe pas dans la liste lst
	  	; donc ce n'est pas la peine de chercher plus loin
	)
) ; cond

 	res
) ; position_bseb67

 

commande: (position_bseb67 '(3 1) '(3 1 3 3 4 200000 1)) => 0

 

 

[Edité le 12/10/2009 par bseb67]

[bonuscad]

Ma contribution, sans fonction vl-

 

(defun position (l2f l / pos i nb n)
(cond
	((and (listp l2f) (listp l))
		(setq i (1- (length l2f)) nb '(0) n 0)
		(repeat i (setq nb (cons (1+ (car nb)) nb)))
		(setq nb (reverse nb))
		(while l
			(if (equal (mapcar '(lambda (x) (nth x l)) nb) l2f)
				(setq pos (cons n pos))
			)
			(setq l (cdr l) n (1+ n))
		)
	)
)
(reverse pos)
)

 

Cela à l'air de fonctionner aussi pour la proposition de Tramber

(position '(3 1) '(3 1 3 3 4 200000 1))

 

Et pour par exemple (position '(3 1) '(3 1 3 3 4 200000 3 1 4 6 1 3 1 0))

renvera-> (0 6 11)

 

 

[Edité le 12/10/2009 par bonuscad]

[Tramber]

Mon code rectifié :

 

(defun position (test nlst / compt)
  (setq compt 0)
  (while(not(vl-every '= test nlst))(setq nlst(cdr nlst)compt(1+ compt)))
  (if(and(
 
Tant qu'à être bon, autant être parfait.  :D 

[Patrick_35]

Une autre pour le plaisir

 

Deux Itératives sans vl

 

(defun position2(pos lst / com loc res tot)
 (setq loc 0)
 (while lst
   (setq com pos
  tot 0
   )
   (while com
     (and (eq (car com) (nth tot lst)) (setq tot (1+ tot)))
     (setq com (cdr com))
   )
   (and (eq tot (length pos)) (setq res loc lst nil))
   (setq loc (1+ loc)
  lst (cdr lst)
   )
 )
 res
)

 

ps : bseb67, avec tes lignes, c'est la bouteille que tu as droit ;)

moi, juste un verre :(

 

@+

[bseb67]

Merci, mais la bouteille ce n'est pas la peine,

je ne suis pas fan de boissons alcoolisées.

 

Sauf que je félicite bonuscad pour sa multi-position :)

[(gile)]

Salut,

 

Je craignait que ce challenge n'offre que peu d'intérêt après la première réponse de Tramber qui est très proche de ce j'avais fait (avec vl-every) :

 

(defun position (pat lst / cnt res)
 (setq cnt 0)
 (while lst
   (if (vl-every 'equal pat lst)
     (if (        (setq res cnt
             lst nil
       )
       (setq lst nil)
     )
     (setq cnt (1+ cnt)
           lst (cdr lst)
     )
   )
 )
 res
)

 

La routine de Tramber est plus concise, mais curieusement un tout petit peu moins rapide (même en supprimant le (vl-position ...) inutile à mon avis).

 

Patrick_35, c'est justement en pensant à faire une sorte de vl-string-search pour les listes que j'ai pensé à ce challenge.

 

Sans utiliser vl-every, j'aurais écrit :

 

(defun position (pat lst / cnt res)
 (setq cnt 0)
 (while lst
   (if (apply '= (cons T (mapcar 'equal pat lst)))
     (if (        (setq res cnt
             lst nil
       )
       (setq lst nil)
     )
     (setq cnt (1+ cnt)
           lst (cdr lst)
     )
   )
 )
 res
)

[ElpanovEvgeniy]

Salut!

Ma variante :

 

(defun position (a b / f)
(defun f (a b i n)
 (cond ((> i n) nil)
       ((apply 'and (mapcar '= a b)) i)
       ((f a (cdr b) (1+ i) n))
 ) ;_  cond
) ;_  defun
(f a b 0 (- (length b) (length a)))
) 

 

J'aimais l'idée multi-position...:

(defun multi-position (a b / f)
(defun f (a b i n)
 (cond ((> i n) nil)
       ((apply 'and (mapcar '= a b)) (cons i (f a (cdr b) (1+ i) n)))
       ((f a (cdr b) (1+ i) n))
 ) ;_  cond
) ;_  defun
(f a b 0 (- (length b) (length a)))
) ;_  defun 

[Tramber]

Ils sont fous !

 

Surtout Eugène :cool:

 

Kak Dila (?) Evgeniy ?

[ElpanovEvgeniy]

Ils sont fous !

 

Surtout Eugène :cool:

 

Salut, Tramber!

Pourquoi les fous ?

Que n'est pas correct ?

[Tramber]

I just mean that, you guys, are a bit crazy by spending time on such things !

All is correct. I don't even need to test your code.

 

I was sure that someone would have published some recursivity...and it's you.

 

J'étais certain que quelqu'un allait publier une petite récursivité ...et c'est toi.