Concatener une liste avec un caractère de séparation...

[Matt666]

Salut les gens de CadXP...

 

Voici un petit lisp pluôt sympa pour passer d'une liste à une chaîne de caractères en la concatenant. Bon ce sont mes débuts avec les fonctions apply et mapcar donc on ne rigole pas, mais elle a l'air de bien fonctionner !

;;;****************************************************************
;;; CONCAT
;;; Retourne une chaîne de caractères concaténée avec un caratère de séparation
;;; lst = liste à concatener
;;; car = caractère de séparation
;;; Exemples :
;;; (concat '(0 1 2 3 4 5 6 7 8 9) ",") -> "0,1,2,3,4,5,6,7,8,9"
;;; (concat '(0 1 2 3 4 5 6 7 8 9) "") -> "0123456789"

(defun CONCAT (lst car / )
    (strcat 
         (apply 
              'strcat 
              (mapcar '(lambda (x) (strcat x car))
              (remove (last lst) lst))
         )
         (last lst)
    )
)

Dites moi ce que vous en pensez !

A bientot.

Matt.

 

 

 

[Edité le 18/9/2007 par Matt666]

[(gile)]

Salut,

 

Tu penses bien que j'ai ça dans ma besace, mais je ne vais pas donner ma solution tout de suite pour que tu puisses continuer à améliorer ta routine sans être trop influencé.

 

Je n'ai pas regardé de très près ta routine, mais d'ores et déjà, je vois que tu emploies comme argument car qui est une fonction LISP "native", et même en changeant çà, çà ne marche pas chez moi :

; erreur: type d'argument incorrect: stringp 0

 

Regarde du côté de vl-princ-to-string (princ-to-string)... et mapcar n'est pas la seule façon...

 

Tu peux aussi essayer aussi dans l'autre sens : chaine avec séparateur -> liste

 

[Matt666]

Ok d'ac je m'y attèle direc !

 

Tu penses bien que j'ai ça dans ma besace

;) Forcément que tu dois avoir ça !!!

 

tu emploies comme argument car qui est une fonction LISP "native"

Sur BricsCad ça fonctionne très bien.. Grmbl

 

Bon je regarde !

Adtal !

 

[Edité le 18/9/2007 par Matt666]

[Matt666]

Peut être la fonction REMOVE, qui si on la renomme devrait fonctionner sous Autocad..

 

(defun CONCAT (lst crt / )
    (strcat 
         (apply 
              'strcat 
              (mapcar '(lambda (x) (strcat x crt))
              (vl-remove (last lst) lst))
         )
         (last lst)
    )
) 

 

En tout cas ça fonctionne sous 2000...

Maintenant je vais tenter avec ton princ-to-string

[(gile)]

J'avais bien vu le vl-remove / remove

 

ta routine fonctionne avec une liste de chaines ("a" "b" "c") mais pas avec d'autre types d'éléments pour lequels strcat ne fonctionne plus.

 

Essaye (strcat "a" "b" "c"), (strcat 1 2 3) ou (strcat a b c) d'où l'utilisation de vl-princ-to-string / princ-to-string.

 

D'aiutre part l'utilisation de vl-remove / remove retournera un résultat erroné si la liste contient des doublons :

(setq lst '(1 2 1 2 1 2)) -> (1 2 1 2 1 2)

(vl-remove (last lst) lst) -> (1 1 1)

[Matt666]

Aaar !!

Mais c'est dur !!!

Grmbl

 

Merci pour toutes ces infos !!

Pour l'instant j'ai ces corrections-ci :

 

(defun CONCAT (lst crt / )
    (strcat 
         (apply 
              'strcat 
              (mapcar '(lambda (x) (strcat (princ-to-string x) crt)))
              (reverse (cdr (reverse lst)))
         )
         (princ-to-string (last lst))
    )
)

Par contre sans le mapcar, ça devient dur, là !! A part un foreach+variable, je vois pas !

 

Génial cette fonction princ-to-string :D

Merci encore pour ton temps passé à me conseiller !

 

J'attends avec impatience ta façon de faire !!

J'essai l'inverse, aussi...

 

 

 

[Edité le 18/9/2007 par Matt666]

[(gile)]

Par contre sans le mapcar, ça devient dur, là !! A part un foreach+variable, je vois pas ! 

 

Regarde repeat et while et puis la récursivité aussi...

[Matt666]

Houlàlà récursivité, je connais pas du tout !

Je vois bien le concept, une fonction qui fait appel à elle-même, mais pour l'instant c'est pas encore ça...

 

Par contre j'essaie la fonction qui extrait une liste d'une chaîne.. Et ça c'est assez balaise, aussi !!

Pour l'instant g un gros code tout pourri :)

 

Mais je ne désespère pas (trop) !

 

[Matt666]

Bon bah voilà un petit bout de code pas dément, mais c'est déjà ça !!

 

 

;;;****************************************************************
;;; CONCATL
;;; Retourne une liste à partir d'une chaîne de caractères concaténée avec un caratère de séparation
;;; str = Chaîne de caractères
;;; car = caractère de séparation
;;; Exemples :
;;; (concatl "0,1,2,3,4,5,6,7,8,9" ",") -> (0 1 2 3 4 5 6 7 8 9) 
(defun CONCATL (str crt / )
    (setq lst nil cn 0)
    (if (/= crt "")
         (progn
              (while (string-search crt str nil)
                   (setq
                        un (string-search crt str nil)
                        lst (cons 
                             (setq eff (chtype (substr str 1 un)))
                             lst
                        )
                        str (string-subst "" (strcat (princ-to-string eff) ",") str nil)
                   )
              )
              (if (/= (substr str 1 (strlen str)) "")
                   (setq lst (cons 
                             (chtype (substr str 1 (strlen str)))
                             lst
                   ))
              )
         )
         (progn
         (repeat (strlen str)
              (setq lst (cons (substr str (setq cn (1+ cn)) 1) lst))
         )
         )
    )
    (if lst (reverse lst))
)

 

Ne te fous pas de moi stoplé !! Je sais, c'est très loin d'être concis, mais ça a le mérite de fonctionner !

Par contre j'arrive pas (encore) à faire une liste de nombres....

ya pas une fonction contraire à princ-to-string ?

Genre ça

(defun chtype (crt / )
    (if (eq crt "0")
         (atoi crt)
         (if (/= (atoi crt) 0)
              (atoi crt)
              (if (/= (atof crt) 0.0000)
                   (atof crt)
                   crt
              )
         )
    )
) 

[Edité le 18/9/2007 par Matt666]

Modification du code : si crt égal "", retourne liste caractère par caractère.

 

[Edité le 18/9/2007 par Matt666]

[(gile)]

Je vois que tu es passé à la fonction inverse, et que tu utilises while c'est bien de changer, c'est comme ça qu'on apprend.

Un petit conseil en passant, déclare tes variables locales, ça tévitera d'avoir à faire des (setq lst nil) et d'avoir des surprises quand une valeur a déjà été affecté à la variable que tu utilises.

 

Concernant la première fonction CONCAT, tu es arrivé à quelque chose de beaucoup mieux, tu pouvais éviter le double reverse en inversant le problème : "je ne veux pas de séparateur après le dernier élément" en "je ne veux pas de séparateur avant le premier élément (avec strcat on ajoute au début comme à la fin) :

 

(defun CONCAT_mapcar (lst sep)
 (strcat (vl-princ-to-string (car lst))
   (apply 'strcat
   (mapcar '(lambda (x)
	      (strcat sep (vl-princ-to-string x))
	    )
	  (cdr  lst)
   )
   )
 )
) 

 

Dans une boucle, quand on connait le nombre d'itérations à faire (longueur de la liste dans ce cas là) on peut utiliser repeat :

 

(defun CONCAT_repeat (lst sep / str)
 (setq str (vl-princ-to-string (car lst)))
 (repeat (1- (length lst))
   (setq lst (cdr lst)
  str (strcat str sep (vl-princ-to-string (car lst)))
   )
 )
) 

 

Sinon avec while quand on ne connais pas le nombre d'itérations (quand on le connait mais que la condition aurait de toutes façons du être évaluée c'est une méthode rapide)

 

(defun CONCAT_while (lst sep / str)
 (setq	str (vl-princ-to-string (car lst)))
 (while (setq lst (cdr lst))
   (setq str (strcat str sep (vl-princ-to-string (car lst)))
   )
 )
) 

 

Et pour finir avec élégance, la récursivité :

 

(defun CONCAT_recursive	(lst sep)
 (if (cdr lst)
   (strcat (vl-princ-to-string (car lst))
    sep
    (lst2str (cdr lst) sep)
   )
   (vl-princ-to-string (car lst))
 )
) 

[Bred]

lst2str....

faute ! :exclam: :exclam:

;)

[Matt666]

Ah oui j'ai vu aussi !!

(defun CONCAT_recursive (lst sep)
    (if (cdr lst)
         (strcat (vl-princ-to-string (car lst))
              sep
              (CONCAT_recursive (cdr lst) sep)
         )
         (vl-princ-to-string (car lst))
    )
)

 

[(gile)]

C'était pour voir si vous suiviez...

 

Je me suis trahi, on sait désormais celle que j'ai sorti de ma besace.

 

[Edité le 18/9/2007 par (gile)]

[Matt666]

C'est vrai que c'est la classe, la récursivité...

je ne veux pas de séparateur avant le premier élément

Oui c'est vrai que c'est beaucoup mieux comme ça !!

 

Je vois que tu es passé à la fonction inverse, et que tu utilises while c'est bien de changer, c'est comme ça qu'on apprend.

Merci ! Que penses-tu de cette dernière ? On peut faire largement bien mieux, mais je la trouve po mal...

 

Je préfère les fonctions sans variables, comme c'est le cas pour mapcar ou l'exemple de récursivité. C'est d'autant plus beau !

 

déclare tes variables locales, ça tévitera d'avoir à faire des (setq lst nil)

Je n'ai jamais compris pourquoi il fallait déclarer les variables !! Maintenant c'est fait.

Le fait de faire ça, si je comprend bien, met à nil celles-ci ? C'est génial ça didon !

 

bon bah dément ! J'en aurais encore appris un paquet aujourd'hui ! Merci Gile !!

[(gile)]

Matt666,

 

Tu dois pouvoir améliorer ta routine CONCATL au vu de celles que j'ai données, avec while puisque tu es parti de là ou avec les autres méthodes si tu en as le courrage.

 

Pour les histoires de déclaration de variables, tu peux voir ici, ou encore essayer cette séquence à la ligne de commande :

 

(defun test1 () (setq a 2) (print a) (princ))

(defun test2 (/ a) (setq a 3) (print a) (princ))

 

(setq a 1) -> 1

!a -> 1

(test1) -> 2

!a -> 2

(test2) -> 3

!a -> 2

 

Où apparaît l'intérêt de déclarer les variables locales et occasionellement de conserver certaines variables globales pour pouvoir rappeler leurs valeurs entre plusieurs lancements d'une routine (dernière valeur entrée par l'utilisateur par exemple). Dans ce cas il est prudent de donner des noms long et peu courant à ces variables pour éviter les conflits, il est aussi une convention que les noms commencent et finissent par une astérisque ex : *nom_de_la_variable_globale*

 

Pour la récursivité tu peux voir ce sujet et cette réponse ou celle là

[Patrick_35]

Salut

 

Et la manière itérative ;)

 

(defun CONCAT_iterative (lst sep / res)
 (while lst
   (if res
     (setq res (strcat res sep (vl-princ-to-string (car lst))))
     (setq res (vl-princ-to-string (car lst)))
   )
   (setq lst (cdr lst))
 )
 res
)

 

@+

 

[Edité le 18/9/2007 par Patrick_35]

[(gile)]

Salut Patrick_35,

 

regarde réponse 9 ;)

[Patrick_35]

Bon, bah je vais me coucher, d'autant que ta déclaration de la variable sur le premier caractère est plus pertinente que la mienne (dans ma boucle, donc un if de trop)

 

@+

[Matt666]

Concours des brutes du lisp !! C'est beau tout ça !! :laugh:

 

Tu dois pouvoir améliorer ta routine CONCATL au vu de celles que j'ai données, avec while puisque tu es parti de là ou avec les autres méthodes si tu en as le courrage.

Bon bah je vais essayer.... Par contre je suis un peu nul avec la gestion des chaines de caractères, notamment le substr... mais bon je vais tenter ! Ne compte par sur moi pour utiliser la récursivité, c'est vraiment trop obscur encore... Il faut que j'étudie ça plus profondément, avec des exemples et tout et tout.. En fait surtout des exemples simples !! :)

 

Pour la récursivité tu peux voir ce sujet et cette réponse ou celle là

Même pas besoin de demander !!!

Dément...

 

Pour la récursivité tu peux voir ce sujet et cette réponse ou celle là

J'ai une dernière question par rapport à ça :

Si on déclare des variables locales genre (defun test (/ ss lst))

est-ce vrai que ces deux variables déclarées son mises à nil avant de commencer ? C'est ça le vrai intérêt de cette déclaration...

Désolé, mais j'aime bien parfaitement comprendre les choses :P

 

Bon je vais poster un nouveau sujet... :)

 

A bientot !

Matt.

[Matt666]

Tu dois pouvoir améliorer ta routine CONCATL au vu de celles que j'ai données

Franchement je vois pas du tout... Chu ptet un peu trop le nez dans mon code... Mais là je donne ma langue à CadXP...

 

avec les autres méthodes

A part un rwhile et une récursivité, je vois pas comment faire !! Et vu que la récursivité, chu une belle bille (de 20), je vois que le while...

 

Je me suis trahi, on sait désormais celle que j'ai sorti de ma besace

LST2STR.... STR2LST ???? :)

 

;;;****************************************************************
;;;****************************************************************
;;; STR2LST
;;; Retourne une liste à partir d'une chaîne de caractères concaténée avec un caratère de séparation
;;; str = Chaîne de caractères
;;; sep = caractère de séparation
;;; 
;;; (str2lst "0,1,,,,2,3,4,5,6,7,8,9" ",") -> (0 1 2 3 4 5 6 7 8 9)
;;; (str2lst "0,1,2,3,4,5,6,7,8,9" "" ) -> ("0" "," "1" "," "2" "," "3" "," "4" "," "5" "," "6" "," "7" "," "8" "," "9")

(defun str2lst ( STR SEP / )
    (setq lst nil cn 0)
    (if (/= SEP "")
         (progn
              (while (string-search SEP str nil)
                   (if (/= (substr str 1 (string-search SEP str nil)) "")
                        (setq
                             lst (cons (setq eff (chtype (substr str 1 (string-search SEP str nil))))lst)
                             str (string-subst "" (strcat (princ-to-string eff) SEP) str nil)
                        )
                        (setq str (string-subst "" SEP str nil))
                   )
              )
              (if (and 
                        (/= (substr str 1 (strlen str)) "")
                        (string-search SEP str nil)
                   )
                   (setq lst (cons (chtype (substr str 1 (strlen str))) lst))
              )
         )
         (repeat (strlen str)
              (setq lst (cons (substr str (setq cn (1+ cn)) 1) lst))
         )
    )
    (if lst (reverse lst))
)
;;;
(defun chtype (CRT / )
    (if (eq CRT "0")
         (atoi CRT)
         (if (/= (atoi CRT) 0)
              (atoi CRT)
              (if 
                   (or  (/= (atof CRT) 0.00)
                        (and (eq (atof CRT) 0.00)
                             (eq (substr CRT 1 4) "0.00")
                        )
                   )
                   (atof CRT)
                   CRT
              )
         )
    )
) 

 

J'ai viré une variable qui ne servait pas... Et voilà !!

J'ai honte... Il va se marrer le (gile) !!

 

Adtal !

Matt.

 

Edition : Maintenant la routine gère les zones vides entre les caractères de séparation...

Voir le 1er exemple de la routine...

 

[Edité le 19/9/2007 par Matt666]

[(gile)]

Salut,

 

La routine don je me sert :

 

;; str2lst
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-position (ascii sep) str))
   (cons (substr str 1 pos)
  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
) 

 

son équivalent iératif (avec while) :

 

(defun str2lst_iter (str sep / pos lst)
 (while (setq pos (vl-string-search sep str))
   (setq lst (cons (substr str 1 pos) lst)
  str (substr str (+ (strlen sep) pos 1))
   )
 )
 (reverse (cons str lst))
) 

[Matt666]

Vache....

Mais il est tout petit ton code !!!!!

Merde :o

Bah euh merci de ne pas t'être foutu de moi !!

 

Par contre juste un truc dans ta routine itérative, il manquerait pas un nil à la fonction vl-string-search ???

 

Et puis elle ne gère pas la nature des chaînes entre séparateur !

genre

(str2lst  "un,deux,,quatre cent,1,2,3,400,,121459.21" ",")
Retourne
("un" "deux" "" "quatre cent" "1" "2" "3" "400" "" "121459.21")
Ou alors, pour reprendre l'exemple de lst2str 
(lst2str '(0 1 2 3 4 5 6 7 8 9) ",") -> "0,1,2,3,4,5,6,7,8,9"
Si on prend la fonction inverse 
(str2lst "0,1,2,3,4,5,6,7,8,9" ",")
Retourne 
("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")

Ce n'est donc pas vraiment l'inverse !

 

Je te propose la routine ci-dessous, qui intègre chtype... Je suis sur que tu as beaucoup mieux, mais je fais ce que je peux ;)

(defun str2lst (str sep / pos lst)
    (while (setq pos (string-search sep str nil))
         (setq lst (cons (chtype (substr str 1 pos)) lst)
              str (substr str (+ (strlen sep) pos 1))
         )
    )
    (reverse (cons (chtype str) lst))
)

 

Avec chtype

(defun chtype (CRT / )
(if (eq CRT "0")
(atoi CRT)
(if (/= (atoi CRT) 0)
(atoi CRT)
(if
(or (/= (atof CRT) 0.00)
(and (eq (atof CRT) 0.00)
(eq (substr CRT 1 4) "0.00")
)
)
(atof CRT)
CRT
)
)
)
)

 

Voilà ! Dis moi ce que tu en penses...

Adtal !

Matt.

 

PS : Limite faudrait presque la mettre en argument, cette extraction en fonction de la nature de la chaîne...

 

Edition : Si "" est le séparateur, ta fonction plante....

(defun str2lst (str sep / pos lst )
    (if (/= sep "")
         (progn (while (setq pos (string-search sep str nil))
                   (setq 
                        lst (cons (chtype (substr str 1 pos)) lst)
                        str (substr str (+ (strlen sep) pos 1)
                        )
                   )
              )
              (setq lst (cons (chtype str) lst))
         )
         (progn 
              (while (/= str "")
                   (setq 
                        lst (cons (chtype (substr str 1 1)) lst)
                        str (substr str 2)
                   )
              )
         )
    )
    (if lst (reverse lst))
)

 

[Edité le 20/9/2007 par Matt666]

[Matt666]

Bon c'est le dernier post que je mets ici !!!! :P

Voilà j'ai fait une fonction qui utilise le lst2str... Différemment mais en gros c'est la même.

Le problème c'est que seule la fonction avec récursivité fonctionne :mad: !!!

Y en a marre !!!

 

Bref je te montre :

;; Calcul du nombre d'entités sous forme de liste 
;; Ex : (("LINE" . 3)("CIRCLE" . 5))
(defun compteur (lst / n js tbl)
    (while lst
         (setq n (length lst)
              js (car lst)
              lst (remove js lst)
              tbl (cons (cons js (- n (length lst))) tbl)
         )
    )
    (sort tbl '(lambda (a b) (< (car a) (car b))))
)

;; Créé la chaîne de caractères à partir de la liste compteur
;; Ex : (("LINE" . 3)) -> "3 entités LINE."
(defun concat (lst)
    (if (cdr lst)
         (strcat 
              (princ-to-string (cdar lst)) 
              " entités " 
              (princ-to-string (caar lst)) 
              "." 
              "\n"
              (concat (cdr lst))
         )
         (strcat (princ-to-string (cdar lst)) " entités " (princ-to-string (caar lst)) ".")
    )
)

;; Retourne le nombre d'entités sélectionnées par type et dans une fenêtre
(defun c:somme (/ cn sel)
    (setq cmdecho (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (if (setq sel (ssget))
         (progn
              (repeat (setq cn (sslength sel))
                   (setq lst (cons (cdr (assoc 0 (entget (ssname sel (setq cn (1- cn)))))) lst))
              )
              (setq infos (concat (compteur lst)))
              (alert (strcat 
                        (itoa (sslength sel)) 
                        " entités sélectionnées."
                        "\n\n" 
                        infos
              ))
    ))
    (princ)
)

 

Voilà ! Simplement tu sélectionnes les entités, et la routine retourne un tableau avec les entités rangées par type...

 

Comme tu peux voir c'est ta fonction avec récursivité qui est utilisée...

 

J'ai essayé de créer une fonction équivalente sans récursivité, mais je ne comprends pas pourquoi elle ne fonctionne pas !

Peux-tu m'aider Gile stp ?

 

Fonction qui merde :

(defun CONCAT2 (lst)
    (strcat
         (princ-to-string (cdar lst)) 
         " entités " 
         (princ-to-string (caar lst)) 
         "." 
         (apply 'strcat
              (mapcar '(lambda (x)
                        (strcat 
                             "\n"
                             (princ-to-string (cdar lst)) 
                             " entités " 
                             (princ-to-string (caar lst)) 
                             "." 
                        )
                   )
                   (cdr lst)
              )
         )
    )
)

 

Merci !

A bientot.

Matt.

[(gile)]

salut,

 

Je vais essater de répondre dans l'ordre

Par contre juste un truc dans ta routine itérative, il manquerait pas un nil à la fonction vl-string-search ???

 

Non, c'est une fonction LISP "native" (pas un defun) donc certains arguments peuvent être optionnéls (contrairement à string-search qui est une fonction définie extérieurement avec defun)

 

Et puis elle ne gère pas la nature des chaînes entre séparateur !

genre

Non elle retourne une liste de chaines, si j'ai besoin de traiter les différents type d'élément de la liste , je le fais à part.

 

CHTYPE : si tu veux les nombres sous forme de nombres (entiers ou réels)

 

(defun chtype (CRT /)
 (cond
   ((= (type (read crt)) 'INT)
    (atoi crt)
   )
   ((= (type (read crt)) 'REAL)
    (atof crt)
   )
   (T crt)
 )
) 

 

ou, encore plus court, l'expression suivante peut être intégrée directement dans str2lst si tu es sûr de vouloir toujours avoir les nombres sous forme de nombres

 

(if (numberp (read crt))

(read crt)

crt

)

 

(defun str2lst (str sep / pos lst crt)
 (while (setq pos (vl-string-search sep str))
   (setq crt (substr str 1 pos)
  lst (cons (if	(numberp (read crt))
	      (read crt)
	      crt
	    )
	    lst
      )
  str (substr str (+ (strlen sep) pos 1))
   )
 )
 (reverse (cons (if (numberp (read str))
	   (read str)
	   str
	 )
	 lst
   )
 )
) 

 

[Edité le 20/9/2007 par (gile)]

[Matt666]

Désolé j'avais pas vu que tu avais répondu !

Non elle retourne une liste de chaines, si j'ai besoin de traiter les différents type d'élément de la liste , je le fais à part.

D'accord ok...

 

(read crt)

Oui je ne connaissais pas l'existence de READ, jusqu'à ce challenge10 !! Bien pratique... Par contre elle ne lit pas les points, faut juste faire gaffe à ça...

 

Sinon je ne sais pas si tu as vu ça, en parlant de fonctions que tu as faites...

 

Voilà, sinon as-tu vu le dernier post que j'ai mis ? je ne sais pas pourquoi la fonction non-récursive ne tourne pas... Si tu pouvais (encore, une fois de plus) m'aider, ce serait assez de la balle !

 

Merci.

A bientot.

Matt.