VDH-Bruno

Bonsoir, Si cela convient je suis heureux d'avoir pu aider, oui il doit être possible d'émuler Rbloc même si je ne suis pas utilisateur de cette routine, mais je n'irais pas plus loin dans ma contribution, n'ayant que très peux de disponibilité pour lisper (à regret), dans mes disponibilité il m'est plus facile d'adapter/réchauffer des codes dont je suis déjà l'auteur (moins chronophage), que de me plonger dans des programmes écrit par d'autres et dont je n'ai pas vraiment l'usage.

Bonsoir, @lecrabe Oui si tu veux, bien qu'elle n'apporte pas grand chose de plus par rapport aux autres propositions sauf si le texte est court. Sinon j'en ai une autre aussi qui peut être proposé, moins performante mais plus dans mon style. (defun vl-yes-they-are-all-there (str / f) (defun f (l m) (if l (f (vl-remove (car l) (cdr l)) (vl-remove (car l) m)) m ) ) (not(f (vl-string->list (strcase str)) '(65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90))) ) @+ Bruno

Et en fusionnant les réponse de chacun, effectivement length apporte une micro optimisation (defun test2 (str) (= 26 (length (member 90 (reverse (member 65 (vl-sort (vl-string->list (strcase str)) '<)))))) ) @+ Bruno

Salut, Pour le jeu mais je n'ai pas de compte sur ce forum, rapidement ma proposition, mais en jetant un oeil rapide sur le fil de discussion je m'aperçois qu'elle ressemble beaucoup à celles qui ont déjà été proposé: (defun test (str) (= 2015 (apply '+ (member 90 (reverse (member 65 (vl-sort (vl-string->list (strcase str)) '<)))))) ) Edit: En un poil plus rapide après test sommaire

Oui merci Patrice bien vu😉, j'ai été un peu rapide dans mon adaptation, la même avec filtrage sur les blocs dynamique (defun c:BD_echX (/ ss i e dxf EchX EchY EchZ) (vl-load-com) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (repeat (setq i (if (setq ss (ssget '((0 . "INSERT")))) (sslength ss) 0 ) ) (setq e (ssname ss (setq i (1- i)))) (if (vlax-invoke (vlax-ename->vla-object e) 'GetDynamicBlockProperties ) (entmod (setq dxf (entget e) EchX (assoc 41 dxf) dxf (subst (cons 42 (cdr EchX)) (assoc 42 dxf) dxf) dxf (subst (cons 43 (cdr EchX)) (assoc 43 dxf) dxf) ) ) ) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (princ) )

Il fallait tester la 2ème routines que je viens d'adapter rapidement pour répondre à ta dernière demande A tester: ;; Tous les facteurs d'échelle des bloc dyn selectionné à la valeur de l'echelle X (defun c:BD_echX (/ ss i e dxf EchX EchY EchZ) (vl-load-com) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (repeat (setq i (if (setq ss (ssget '((0 . "INSERT")))) (sslength ss) 0 ) ) (setq e (ssname ss (setq i (1- i))) dxf (entget e) EchX (assoc 41 dxf) dxf (subst (cons 42 (cdr EchX)) (assoc 42 dxf) dxf) dxf (subst (cons 43 (cdr EchX)) (assoc 43 dxf) dxf) ) (entmod dxf) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ) ) Cdt

Bonjour, Je republie ici des routines extraits de cette discussion: https://cadxp.com/topic/41229-verrouiller-un-bloc-dynamique/?do=findComment&comment=232105 ;;;================================================================= ;;; VPBD.LSP V1.01 VDH-Bruno ;;; ;;; "Verrouille" Les propriétés dynamiques des références de blocs. ;;; (Modifie l'échelle d'insertion en Z de la référence de bloc) ;;; (defun c:vpbd (/ ss i e dxf oldEchZ newEchZ) (vl-load-com) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (repeat (setq i (if (setq ss (ssget '((0 . "INSERT")))) (sslength ss) 0 ) ) (setq e (ssname ss (setq i (1- i)))) (if (vlax-invoke (vlax-ename->vla-object e) 'GetDynamicBlockProperties) (progn (setq dxf (entget e) oldEchZ (assoc 43 dxf) newEchZ (cons (car oldEchZ) (1+ (cdr oldEchZ))) ) (entmod (subst newEchZ oldEchZ dxf)) ) ) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ) ) ;;;================================================================= ;;; DVPBD.LSP V1.01 VDH-Bruno ;;; ;;; "DéVerrouille" Les propriétés dynamiques des références de blocs. ;;; (Homogénise l'échelle d'insertion en Z de la référence de bloc ;;; en fonction des valeurs d'échelle en X et Y) ;;; (defun c:Dvpbd (/ ss i e dxf EchX EchY EchZ) (vl-load-com) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (repeat (setq i (if (setq ss (ssget '((0 . "INSERT")))) (sslength ss) 0 ) ) (setq e (ssname ss (setq i (1- i))) dxf (entget e) EchX (assoc 41 dxf) EchY (assoc 42 dxf) ) (if (= (cdr EchX) (cdr EchY)) (entmod (subst (cons 43 (cdr EchX)) (assoc 43 dxf) dxf)) ) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ) ) @+ VDH-Bruno

Bonjour, Oui je comprends pas de soucis, je complète tout de même car à la relecture je me suis aperçu que j'étais hors sujet dans mon hors sujet avec le Lisp en listant la table des type de ligne, car si tu veux seulement tester la présence d'un type de ligne, je rappellerai que AutoLisp est bien outillé pour celà et les fonctions tblobjname, tblsearch sont tes amis, au cas ou tu dois garder quelque chose sous le coude. Pour l'exemple: _$ (tblsearch "LTYPE" "CONTINUOUS") ((0 . "LTYPE") (2 . "CONTINUOUS") (70 . 0) (3 . "Solid line") (72 . 65) (73 . 0) (40 . 0.0)) _$ (tblsearch "LTYPE" "typedeligneinexistant") nil _$ (tblobjname "LTYPE" "CONTINUOUS") <Nom d'entité: -14c360> _$ (tblobjname "LTYPE" "typedeligneinexistant") nil Cdt

Bonjour, Comme Luna un peu hors sujet pour du VBA, pour lister les types de lignes présentes dans un dessin: En vlisp: (vlax-for l (vla-get-LineTypes (vla-get-activedocument (vlax-get-acad-object))) (princ (strcat "\n" (vla-get-Name l))) ) ou comme ceci: (vlax-map-collection (vla-get-LineTypes (vla-get-activedocument (vlax-get-acad-object))) '(lambda (l) (princ (strcat "\n" (vla-get-Name l)))) ) Sinon en AutoLisp: ;;; TBLNEXTLIST VDH-Bruno ;;; Retourne la liste les noms de symboles correspondant aux appels successifs à la fonction tblnext ;;; Argument ;;; n -> Nom de table ("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT") ;;; f -> Si f (flag) est non nil, TBLLIST retourne tous les nom depuis la première entrée (defun tblnextlist (n f) (if (setq f (tblnext n f)) (cons (cdr (assoc 2 f)) (tblnextlist n nil)))) A lancer comme ceci: (tblnextlist "LTYPE" T) Et d'une façon plus général pour avoir à disposition une liste de fonction plus spécifique sur le model de la fonction (layoutlist) ;;; Ensemble de fonctions pour lister les noms de symboles des tables VDH-Bruno ;;; (LAYERLIST) -> Retourne la liste des Noms de calque ;;; (LTYPELIST) -> Retourne la liste des Noms de type de ligne ;;; (VIEWLIST) -> Retourne la liste des Noms de vue ;;; (STYLELIST) -> Retourne la liste des Noms de style de texte ;;; (BLOCKLIST) -> Retourne la liste des Noms de bloc ou nil ;;; (UCSLIST) -> Retourne la liste des Noms de SCU ou nil ;;; (APPIDLIST) -> Retourne la liste des Noms d'application ou nil ;;; (DIMSTYLELIST)-> Retourne la liste des Noms de style de cote ;;; (VPORTLIST) -> Retourne la liste des Noms de fenêtre ou nil (mapcar '(lambda (tbl) (eval (list 'defun (read (strcat tbl "list")) nil (list 'tblnextlist tbl T))) ) '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT") ) Cdt VDH-Bruno

Bonjour, Comme j'eusse aimé avoir connaissance ces algorithmes par le passé, cela m'aurait évité de longues heures de recherche... Au passage il me semble que c'est un fisrt-fit qui est proposé par (gile)😉 Comme je n'ai pas pu retrouvé mes codes de l'époque pour le jeu et ne pas perdre la main je me suis amusé à réécrire ces 2 algorithmes, écriture générique fonctionnant avec des listes simple sans tenir compte des handles Pour le first-fit decreasing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; https://fr.wikipedia.org/wiki/Problème_de_bin_packing ;; bin packing à une dimension (first-fit decreasing) (defun bin-packing (lstObj dimension / FFD) ;; first-fit decreasing (defun FFD (lstobj dim objrestant) (if lstobj (if (<= (car lstobj) dim) ((lambda (x acc) (cons (cons x (car acc)) (cdr acc))) (car lstobj) (FFD (cdr lstobj) (- dim (car lstobj)) objrestant) ) (FFD (cdr lstobj) dim (cons (car lstobj) objrestant)) ) (if objrestant (cons nil (FFD (reverse objrestant) dimension nil)) ) ) ) (FFD (vl-sort (mapcar 'float lstObj) '>) dimension nil) ) J'espère que certains apprécieront l'astuce du (cons nil (... (cons nil (FFD (reverse objrestant) dimension nil)) pour scindé les listes à la remonté des appels Pour le best-fit decreasing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; https://fr.wikipedia.org/wiki/Problème_de_bin_packing ;; bin packing à une dimension (best-fit decreasing) (defun bin-packing (lstObj dimension / lstboite BFD) ;; best-fit decreasing (defun BFD (obj lstboite / boite) (cond ((null lstboite) (list (list obj))) ((<= (apply '+ (setq boite (cons obj (car lstboite)))) dimension) (cons boite (cdr lstboite)) ) (T (cons (car lstboite) (BFD obj (cdr lstboite)))) ) ) (mapcar '(lambda (obj) (setq lstboite (BFD obj lstboite))) (vl-sort (mapcar 'float lstObj) '>) ) lstboite ) @+ VDH-Bruno

Bonjour, Et pourquoi ne pas faire des regroupements de liste par couleur diamètre et construire la liste comme ceci: ( (diametre1 ((long1 . handle1) (long2 . handle2) ... (longN . handleN))) (diametre2 ((long1 . handle1) (long2 . handle2) ... (longN . handleN))) ... (diametreN ((long1 . handle1) (long2 . handle2) ... (longN . handleN))) ) Car "la mise en barre" sur des barres de nature différente c'est un peu comme additionner des choux et des carottes? Cdt Bruno

Bonsoir Rapidement pour le jeu et ne pas taper dans les 6 façons différentes en "pur AutoLISP", pas forcément la façon la plus efficiente sur de grande lwp car la fonction ne mémorise pas la liste de définition de l'entité, mais y accède pour chaque sommet extrait. (defun Get-pt-list (e / f) (defun f (i / pt) (if (setq pt (vlax-curve-getPointAtParam e i)) (cons pt (f (1+ i))) ) ) (f 0) ) @Luna Bien que la fonction travail indifféremment avec un argument au format vla-objet ou ename, au jeu des comparaisons elle gagnera à être regardé avec un argument au format ename, la valeur de retour comme la proposition de BonusCAD retournera la coordonnée en Z dans la liste des points, et si la Lwpolyline est close le premier sommet est répété en fin de liste

Bonjour, Oui je connais ces messages, pour cette raison j'ai mauvaise conscience à proposer la moindre ligne de code sur ce challenge.

Merci pour la façon suivante de lancer le traitement: Je suis assez d'accord, par contre pour la partie qui suit je suis encore mitigé: J'ai essayé des truc plus ou moins farfelu dans le WE, pour en faire quelque chose d’élégant: factorisation, récursion mutuelle, utilisation de set, imbrication de or et and etc.. A par obscurcir et compliquer le code j'ai pas réussi à traiter cette partie mieux que ça..

Bonjour, Je reviens sur le sujet pour proposer mon 2ème jet de la fonction QuickHull Dans cette deuxième version j'ai voulu garder l'esprit du premier algorithme, à savoir la fonction filtre les points à droite de la droite (ptA ptB), puis filtre les points à droite de la droite (ptB ptC) parmi les points à gauche de la droite (ptA ptB). De ce fait les aires algébriques à droite de la droite (ptA ptB) ne sont calculé qu'une seule fois. Voilà j'ai essayé pour le jeu d'allier l'efficience (avec un gain modeste), sans trop sacrifier la concision des lignes de code donné par (gile) (defun QuickHull (pts / area getQuickHull lst minX maxX) (defun area (p1 p2 p3) (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1))) ) ) (defun getQuickHull (ptA ptB ptC pts / a refAB refBC ptAB ptBC lstAB lstBC) (if pts (progn (setq refAB 0 refBC 0) (foreach p pts (if (minusp (setq a (area ptA ptB p))) (and (setq lstAB (cons p lstAB)) (< a refAB) (setq refAB a) (setq ptAB p) ) (and (minusp (setq a (area ptB ptC p))) (setq lstBC (cons p lstBC)) (< a refBC) (setq refBC a) (setq ptBC p) ) ) ) (append (getQuickHull ptA ptAB ptB lstAB) (getQuickHull ptB ptBC ptC lstBC)) ) (list ptA) ) ) (setq lst (mapcar 'car pts) minX (assoc (apply 'min lst) pts) maxX (assoc (apply 'max lst) pts) ) (getQuickHull minX maxX minX pts) ) A+ Bruno

Bonjour @(gile), Pour le retour (et la petite blague), en détaillant hier soir le fonctionnement de ton QuikHull, je me suis aperçu que tu générais des sommets superposés, graphiquement tu as le bon nombre de coté, mais trop de sommets. Pour t'en convaincre en exemple sur polygone convexe à 11 cotés généré avec la commande test, la ligne de code suivante m'indique 17 sommets.... _$ (cdr (assoc 90 (entget (car (entsel))))) 17 J'ai mis un moment à comprendre, mais c'est tout bête, c'est la variable pt qui fait nous un effet de bord... dans le code tu as omis de la localisé dans la fonction appelante loop, une fois fait tout rentre dans l'ordre.😊 A+ Bruno

Bonjour @didier Bien que je sois intimement convaincu que tu trouveras (à raison) toujours plus d'inspiration dans les lignes de (gile) que dans les miennes, si des fois il y en a une ou deux qui te conviennent en ce qui me concerne tout ce qui est sur les forums est libre de droit, être repris est toujours une forme de reconnaissance😉 Pour une date de dépôt je suis plus mitigé, l'esprit d'un challenge est un jeu entre vitesse d'écriture et optimisation des lignes de code, personnellement je n'ai pas d'état d'âme à poster rapidement si je pense que la solution n'est pas optimal (car elle sera facilement détrôner Cf ma réponse sur ce challenge). Par contre si je crois avoir là solution, je temporise au maximum avant de poster, bien qu'à ce petit jeu je me fait bien souvent prendre et m'en amuse😄 Il m'est aussi arrivé de faire une proposition au hasard d'un code, bien après l'émission d'un challenge, pour moi il n'y pas de date limite de temps. A+ Bruno

@(gile) Clap clap clap, chapeau bas, pour la concision je ne crois pas que l'on puisse faire mieux, l'air algébrique (qui donne la position, la surface et le donc point le plus éloigné) "mais c'est bien sur" cela ne m'a même pas effleuré l'esprit, pourtant je le sais et je l'ai écrit donc sur ce coup je m'en amuse (c'est pas faute d'avoir réfléchi pour le faire en un passage, set était bien présent en tête si je trouvais ce moyen😉). Je n'ai aucun regret je m'étais imposé 1h pour écrire le quickHull, j'ai débordé cela m'a pris 1h45, c'est le maximum que je pouvais faire dans le temps imparti. D'avoir participé me permet d’apprécié au mieux ces lignes de codes, un grand MERCI à toi

@didier, Oui bravo, ça fonctionne, tu as implémenté l’algorithme de Graham's il me semble, il te reste encore a implémenter l'algorithme Quickhull

@(gile)Je ne doute pas de la concision de ta version, que je détaillerai avec sourire en me disant "mais c'est bien sur", pour un second jet c'est compliqué, je suis entrain de pisser du trait en mode dessinateur d’exécution, pour la quarantaine de bonhommes qui attendent lundi dans l’atelier ferraillage/coffrage, les joies du télétravail (le travail qui s'invite à la maison, et non le travaille devant la télé comme certains seraient tenté de croire). @didier Pas de soucis j'ai beaucoup d'humour, je ne me suis pas sentie visé d’ailleurs celle-ci: lu comme ça, cela m'a beaucoup amusé😊 Après algorithme tel que proposé sur la page Wikipédia me semble pas incompatible avec un style impératif. Donc ça devrait aboutir bonne continuation à toi Salutations Bruno

Désolé Didier, mais comme je voyais pas mal de commentaires, j'ai cru à tord que le challenge était un peu bloqué... Alors je m'y suis attelé ce matin. Amicalement aussi A+ Bruno

Bonjour, Rapidement un premier jet: (defun Quickhull (lst / P Q position cut-pts getPtH HalfConHull) ;; Position d'un point C par rapport à une droite orienté (AB): 0 = sur la droite; 0 < au-dessus; 0 > au-dessous (defun position (A B C) (- (* (- (car B) (car A)) (- (cadr C) (cadr A))) (* (- (cadr B) (cadr A)) (- (car C) (car A))) ) ) ;; coupe une lite de points en 2 par rapport à un segment ->( (liste des points dessus)(liste des points dessous)) (defun cut-pts (A B lst haut bas) (cond ((null lst) (list haut bas)) ((minusp (position A B (car lst))) (cut-pts A B (cdr lst) haut (cons (car lst) bas)) ) ((zerop (position A B (car lst))) (cut-pts A B (cdr lst) haut bas) ) (T (cut-pts A B (cdr lst) (cons (car lst) haut) bas)) ) ) ;; Recherche de point le plus éloigné en fonction de 2 pt et d'une liste de points (defun getPtH (pt1 pt2 lpt / dist H) (setq dist 0.) (foreach x lpt (if (< dist (+ (distance pt1 x) (distance x pt2))) (setq H x dist (+ (distance pt1 x) (distance x pt2)) ) ) ) H ) ;; Demi enveloppe convexe (defun HalfConHull (P Q lst / H) (cond ((null (cdr lst)) lst) (T (setq H (getPtH P Q lst) lst (cut-pts P H lst nil nil) ) (append (HalfConHull P H (car lst)) (cons H (HalfConHull H Q (car (cut-pts H Q (cadr lst) nil nil))) ) ) ) ) ) ;; Traitement (if (< (length lst) 4) lst (setq P (assoc (apply 'min (mapcar 'car lst)) lst) lst (vl-remove P lst) Q (assoc (apply 'max (mapcar 'car lst)) lst) lst (cut-pts P Q lst nil nil) lst (append (cons P (HalfConHull P Q (car lst))) (cons Q (HalfConHull Q P (cadr lst))) ) ) ) ) Pas tout à fait la version que je voulais donner, mais celle-ci à l'air de faire le travail. Peut être si je peux (le temps) je regarderai pour d'éventuelle optimisation. (Ps: J'ai pris le partie de supprimer les éventuels points aligné dans les segments droit😉) A+ Bruno

Oui tout à fait, merci d'avoir complété et élargie mon propos que j'avais limité aux versions impératives qui ont des versions récursives équivalentes, pour essayé de montrer que passer par un raisonnement par récurrence, peut aussi permettre de reformuler la résolution de façon plus optimal même pour une écriture dans un style plus impératif. (Ps:@(gile): Jolie démonstration pour le append, cons)

Bonjour, @Fraid append est moins efficient que un reverse + cons, j'ai beaucoup de mal à retrouver mes sujets sur ce forum, mais nous en avions déjà fait une démonstration dans de précédent challenges, pour les testes sur de grande liste les versions impératives qui utilisent reverse sont meilleurs que leurs versions récursives. @(gile)Bien que le (eval fun) soit exécuté à chaque appel, je préfère utiliser la "fonction lambda enveloppante" en bibliothèque (pas en challenge) par goût et par clarté avec l'habitude ce style de structure est devenu idiomatique, au premier coup d’œil, je sais comment s'exécute le traitement de haut en bas ou de bas en haut. Ne "lispant" plus que par loisir je suis moins dans l'optimisation de l'écriture. @Tous: Si on devait trouver une moral, pour moi elle est dans cette déclaration: Qui rejoint dans mon esprit la suivante: "Inverser une donné puis permuter ses termes 2 à 2, revient à grouper les termes 2 à 2 puis à inverser le résultat." Lors d'un récent challenge sur la manipulation de chaîne. Bien qu'en AutoLisp les versions impératives sont toujours meilleurs que les versions récursives équivalentes, la façon qu'à la récursivité de s'exprimer en partant du bas vers le haut, permet bien souvent de reformuler les hypothèses de départ pour écrire de façon plus efficiente les versions impératives. Rapidement un dernier lien que j'ai en tête ici pour illustrer cette approche, l'on pourrait les multiplier à travers le forum. En conclusion la récursivité est utile mais pas indispensable, mais utile 😉. Salutations Bruno

Bonjour, Visiblement il n’y a pas eu foule, ça ne me semblait pas un exercice trop dur à relever (j’espère tout de même qu’il y en a quelques-uns qui ont tenté de plancher de leurs coté). Dans ce challenge outre le fait que la fonction soit d’ordre supérieur (c’est-à-dire qu’elle accepte une fonction en argument), la fonction en argument comparant les éléments 2 à 2, l’éventuelle difficulté dans le traitement, c’est de vouloir construire la liste en retour par la queue (au moyen d’append), alors qu’une liste se construit plus simplement par la tête (avec cons)… En récursif dans la version que j’utilise en bibliothèque, cette difficulté est aisément contourné (en l’absence de fonction let qui contextualise les appels) par une fonction lambda enveloppante qui déroule la pile d’appel et permet de construire la liste à la remonté des appels donc par la queue de liste qui devient la tête (un tête à queue en quelque sorte 😄). Le code : (defun split-if-not (pred lst) (if (cdr lst) ((lambda (loop) (if ((eval pred) (car lst) (caar loop)) (cons (cons (car lst) (car loop)) (cdr loop)) (cons (list (car lst)) loop) ) ) (split-if-not pred (cdr lst)) ) (list lst) ) ) Et en interchangeant les 2 lignes du if on obtient l’autre fonction (defun split-if (pred lst) (if (cdr lst) ((lambda (loop) (if ((eval pred) (car lst) (caar loop)) (cons (list (car lst)) loop) (cons (cons (car lst) (car loop)) (cdr loop)) ) ) (split-if pred (cdr lst)) ) (list lst) ) ) Pour la version itérative en partant de la récursive ça devient tout de suite plus facile, car on comprend de suite que pour travailler sur la tête de liste, il suffit d’inverser la liste en argument. Version avec foreach : (defun split-if-not (fun lst / res) (setq fun (eval fun) lst (reverse lst) res (list (list (car lst))) ) (foreach x (cdr lst) (if (fun x (caar res)) (setq res (cons (cons x (car res)) (cdr res))) (setq res (cons (list x) res)) ) ) ) Ou la même en un peu moins lisible avec un cond : (defun split-if-not (fun lst / res) (setq fun (eval fun) lst (reverse lst) res (list (list (car lst))) ) (foreach x (cdr lst) (setq res (cond ((fun x (caar res)) (cons (cons x (car res)) (cdr res))) (T (cons (list x) res)) ) ) ) ) Version avec while : (defun split-if-not (fun lst / x res) (setq fun (eval fun) lst (reverse lst) res (list (list (car lst))) ) (while (cdr lst) (setq lst (cdr lst) x (car lst) res (cond ((fun x (caar res)) (cons (cons x (car res)) (cdr res))) (T (cons (list x) res)) ) ) ) ) (gile) à proposé une version plus efficiente dans sa récursive avec des (reverse (cons (reverse dans une forme terminale avec accumulateur et fonction auxiliaire, j’ai au premier abord pensé à tort, que c’était due au style enveloppant avec l’emploie d’une fonction lambda (plus lente) et le fait qu’à vouloir ne faire que fonction je ne pouvais optimiser l’appel à la fonction argument (eval pred). Qu’a cela ne tienne j’ai revu ma copie en nommant ma fonction lambda en foo et ma fonction split-if-not en bar (car je trouve toujours dommage de devoir employer reverse /append quant ça peut facilement être évité avec la liberté de raisonnement qu’offre la récursivité. Code révisé: (defun split-if-not (f l / bar foo) (defun bar (m) (if (f (car l) (caar m)) (cons (cons (car l) (car m)) (cdr m)) (cons (list (car l)) m) ) ) (defun foo (f l) (if (null (cdr l)) (list l) (bar (foo f (cdr l)))) ) (foo (eval f) l) ) Comme le résultat m’a permis de m’approcher de la récursive de (gile) mais pas de passer devant, en dernière tentative, j’ai fait le trajet inverse c.a.d de partir d’une version itérative (version foreach) pour la convertir en récursive (chose qu'habituellement je ne fait jamais), je suis arrivé à l’écriture suivante : (defun split-if-not (pred lst / loop) (defun loop (f l acc) (cond ((null l) acc) ((f (car l) (caar acc)) (loop f (cdr l) (cons (cons (car l) (car acc)) (cdr acc)))) (T (loop f (cdr l) (cons (list (car l)) acc))) ) ) (loop (eval pred) (cdr (setq lst (reverse lst))) (list (list (car lst)))) ) Ce qui finalement revient à peu de chose au même résultat que l’expression de (gile) en factorisant les reverse. Donc bravo à (gile) qui a été directement au plus efficace, malgré les reverse qui pour le coup se sont vu justifié.