Récursivité

[pingoo666]

Bonjour,

 

Je cherche à faire une fonction qui prend comme valeur un string et qui retourne la liste de tous les combinaisons ou le espaces seraient remplacés (ou pas) par des sauts de ligne

 

Je sais c'est pas clair...

 

Un exemple :

"bonjour a tous"

 

retournera :

"bonjour a tous"
"bonjour/na tous"
"bonjour a/ntous"
"bonjour/na/ntous"

le /n représentant le saut de ligne.

 

J'espérait pouvoir le faire de manière récursive mais je sèche...

 

Des iddées ?

 

Merci d'avance !

[alala]

La fonction vl-string-subst dans un boucle (car ça ne remplace que le premier terme).

 

(while
   (/=
       message
       (setq message (vl-string-subst "\n" " " message))
   )
)
(princ message)

 

En espérant avoir pus répondre à ta demande.

 

edit : oups j'ai lus trop vite, donc non ça ne répond pas, je regarde plus en détail et j'édit si je trouve la soluce.

[(gile)]

Salut,

 

Un premier jet :

 

(defun pingoo (new old str / foo)
 (defun foo (str pos)
   (if	(setq pos (vl-string-search old str pos))
     (append
(foo (vl-string-subst new old str pos) pos)
(foo str (1+ pos))
     )
     (list str)
   )
 )
 (foo str 0)
)

 

(pingoo "\n" " " "bonjour a tous")

retourne :

("bonjour\na\ntous" "bonjour\na tous" "bonjour a\ntous" "bonjour a tous")

[VDH-Bruno]

Bonsoir,

 

Ma variante:

(defun fun (n o s)
 (if (not (eq s (setq s (vl-string-subst n o s))))
   (cons (vl-string-translate (strcat n o) (strcat o n) s)
  (cons s (fun n o s))
   )
 )
)

 

Pour tester:

_$ (fun "\n" " " "bonjour a tous")

("bonjour a\ntous" "bonjour\na tous" "bonjour a tous" "bonjour\na\ntous")

 

A+

 

(Edit: Oupss!!! Au jeu de la concision, j'ai fait une erreur de raisonnement le code échoue sur des phrases à plus de 2 intervales, donc pour ce soir pas mieux que le code de (gile) )

Modifié le 13 décembre 2012 par VDH-Bruno

[alala]

Ma réponse avec de la logique binaire (et du logand par la même occasion, ma premiére fois!) :

 

(defun transbinmessage (new old message / listmessage tota messagetrans )
(setq i 0)
(setq listmessage (mapcar '(lambda (x) (if (/= (ascii old) x) (cons 0 x)(cons (if (= 0 i)(setq i (1+ i))(setq i (* 2 i))) x))) (vl-string->list message)))
(setq tota (* 2 i))
(setq j 0)
(setq touslescas '())
(repeat tota
(setq messagetrans (mapcar '(lambda (x) (if (/= 0 (logand (car x) j)) (setq x (ascii new))(setq x (cdr x)))) listmessage))
(setq touslescas (append (list (vl-list->string messagetrans)) touslescas))
(setq j (1+ j))
)
(princ touslescas))

 

Par contre ça ne fonctionne que sur un caratére (ici il est demander un espace) en entrée comme en sortie (le saut de ligne est un caractére unique).

 

Pour faire au plus simple j'ai donné un poid binaire à chaque espace (ou variable old recherché ici), puis avec un logand je cherche toutes les possbilités dans la table binaire correspondant au nombre d'occurence trouvés et je remplace l'occurence par la variable new si elle se trouve dans la table binnaire à ce moment la.

[VDH-Bruno]

Bonjour,

 

Aprés réflexion je me dis que le premier jet de (gile) est un excelent jet !!!

Ci-dessous, le mieux de ce que j'ai pu produire:

(defun f (n o s / p l flag)
 (if (setq p (vl-string-search o s))
   (mapcar '(lambda (x) (strcat (substr s 1 p) (if (setq flag (not flag)) "\n" " ") x))
     (append (setq l (f n o (substr s (+ 2 p)))) (cdr l) (list (car l)))
   )
   (list s)
 )
)

 

 

Pour tester:

_$ (f "\n" " " "tous le monde")
("tous\nle\nmonde" "tous le monde" "tous\nle monde" "tous le\nmonde")

 

 

A+

 

Ps: alala, belle maitrise du logand ;)

[VDH-Bruno]

Bonjour,

 

Une version bien meilleur en "récursif terminal" avec mapcar, sur ce type de probleme ( 2 puissance n ), on a un arbre des solutions plus large que profond, ce qui normalement avantage mapcar, en y ajoutant une stratégie de division dans la recherche, je pense que l'on a la meilleure solution.

 

(defun fun (n o s / foo)
 (defun foo (l p)
   (if	(setq p (vl-string-search o s p))
     (foo (append l (mapcar '(lambda (x) (vl-string-subst n o x p)) l)) (1+ p))
     l
   )
 )
 (foo (list s) 0)
)

 

 

A+

[(gile)]

Excellent !!!

Bravo, j'aurais aimé avoir écrit cette routine...

[pingoo666]

Bon, vous êtes tous des grands malades.

 

j'avais commencé à m'enbarqué dans des whiles sans fin...

 

Merci beaucoup !

[VDH-Bruno]

Bonjour,

 

(gile) étant un grand admirateur de l’élégance qui caractérise le plus souvent l’écriture de tes codes, je ne pouvais espérer plus beau compliment :) .

 

 

Bon, vous êtes tous des grands malades.

j'avais commencé à m'enbarqué dans des whiles sans fin...

pingoo666 tu auras sans doute compris qu’en ce qui me concerne "l’agent pathogène" s’appelle (gile), sinon plus sérieusement, dans le code précédent, on aurait pu aisément se passer de la fonction auxiliaire foo, en renseignant directement l’argument string sous forme de liste :

(defun f (n o l / p)
 (if (setq p (vl-string-search o (car l)))
   (f n o (append (mapcar '(lambda (x) (vl-string-subst n o x p)) l) l))
   l
 )
)

 

Pour tester :

_$ (f "-" " " (list "bonjour a tous"))
("bonjour-a-tous" "bonjour a-tous" "bonjour-a tous" "bonjour a tous")

 

 

Sinon pour ce qui est du code en lui-même il utilise plus un algorithme que l’on peut qualifier d’exponentiation rapide, plutôt qu’un algorithme réellement récursif comme on le trouve dans le code proposé par (gile), ici l’appel récursif est une coquetterie car il intervient principalement en tant que boucle, il est donc aisément traductible son forme impérative avec la fonction while:

(defun f-while (n o s / l p)
 (setq l (list s)
       p 0
 )
 (while (setq p (vl-string-search o s p))
   (setq l (append l (mapcar '(lambda (x) (vl-string-subst n o x p)) l))
         p (1+ p)
   )
 )
 l
)

 

Pour tester :

_$ (f-while "-" " " "bonjour a tous")
("bonjour a tous" "bonjour-a tous" "bonjour a-tous" "bonjour-a-tous")

 

 

A+ Bruno

[VDH-Bruno]

Re,

 

Sinon pour le fun et rester dans le sujet du récursif, avec le même algorithme pour ceux qui préfèrent le style enveloppant :

(defun f (n o s / p)
 (if (setq p (vl-string-search o s))
   ((lambda (l) (append (mapcar '(lambda (x) (vl-string-subst o n x p)) l) l))
     (f n o (vl-string-subst n o s p))
   )
   (list s)
 )
)

 

Ou alors comme celà:

(defun f (n o s / p l)
 (if (setq p (vl-string-search o s))
   (append (mapcar '(lambda (x) (vl-string-subst o n x p)) (setq l (f n o (vl-string-subst n o s p))))
           l
   )    
   (list s)
 )
)

 

Pour tester :

_$ (f "-" " " "Bonjour a tous")
("Bonjour a tous" "Bonjour a-tous" "Bonjour-a tous" "Bonjour-a-tous")

 

A+

[alala]

Et moi qui m'ennuyais avec une verif de logique binaire ...

 

Vos codes sont magnifiques, j'espére avoir vos niveaux un jour!

[krunch]

Less is more... Bravo quelle classe !

[Fraid]

j'en ai les parentheses qui se croisent....