Aller au contenu

[Challenge] Fonction "d'ordre supérieur"


VDH-Bruno

Messages recommandés

Bonjour à tous,

Dans un challenge précédent il a été rappelé au moyen d'une fonction groupBy l’intérêt de définir des fonctions générique, dans cette esprit (et en plus simple je pense) je propose ici d'écrire une fonction de coupure "générique" (très pratique après une fonction de tri) qui prendrait en argument une fonction prédicat appliqué à une liste:

(coupure-if-not predicate-function liste)

Pour tester

_$ (coupure-if-not '= '(0 0 0 1 1 0 1 1 1 0 0 0 0 1))
 ((0 0 0) (1 1) (0) (1 1 1) (0 0 0 0) (1))

_$ (coupure-if-not '(lambda (x y) (= x (1- y))) '(1 2 3 4 6 6 7 8 10 11))
((1 2 3 4) (6) (6 7 8) (10 11))


Et/ou la fonction symétrique (normalement si on a l'une des deux il est aisé de faire l'autre)

(coupure-if predicate-function liste)

Pour tester

_$ (coupure-if '= '(0 0 0 1 1 0 1 1 1 0 0 0 0 1))
 ((0) (0) (0 1) (1 0 1) (1) (1 0) (0) (0) (0 1))

_$ (coupure-if '(lambda (x y) (= x (1- y))) '(1 2 3 4 6 6 7 8 10 11))
((1) (2) (3) (4 6 6) (7) (8 10) (11))


Le but de ce challenge est de ce familiariser avec l'écriture/utilisation des fonctions dite "d'ordre supérieur", pour laisser tout à chacun le loisir de réfléchir au problème , je ne pense pas remettre ma copie avant Mardi soir ou Mercredi en journée. Pour ceux qui ont déjà cette fonction en magasin prière d'attendre les premières propositions ou tentative de propositions.

(En cas de difficulté regarder du coté des fonctions vl-remove-if-not, vl-remove-if, vl-member-if-not, vl-member-if. (gile) en à déjà proposé des équivalences sur le forum, si je retrouve le lien je le posterai).
 

Bon WE à tous

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

Depuis ce matin que je suis la dessus.

J'ai bien réussi avec '= en argument mais pas la fonction lambda...

sans chercher à optimiser 

(defun coup-if-not (fct lst / posl ret ltmp)
	(setq posl 0)
	(repeat (length lst)
		(if (not ltmp)(setq ltmp (append ltmp (list (nth posl lst)))))
		(if ((eval fct) (nth posl lst) (nth (1+ posl) lst))
			(setq ltmp (append ltmp (list (nth (1+ posl) lst))))
			(setq ret (append ret (list ltmp)) ltmp nil)
		)
		(setq posl (1+ posl))
	)
	ret
)

(defun coup-if (fct lst / posl ret ltmp)
	(setq posl 0)
	(repeat (length lst)
		(if (not ltmp)(setq ltmp (append ltmp (list (nth posl lst)))))
		(if (not((eval fct) (nth posl lst) (nth (1+ posl) lst)))
			(if (nth (1+ posl) lst)(setq ltmp (append ltmp (list (nth (1+ posl) lst)))))
			(setq ret (append ret (list ltmp)) ltmp nil)
		)
		(setq posl (1+ posl))
	)
	(if ltmp (append ret (list ltmp)) ret)
)

Cela doit être eval qui n'est pas adapté...

je ne sait plus quoi testé

une petite piste?

Lien vers le commentaire
Partager sur d’autres sites

Voici donc ma solution (avec l'aide gile)

(defun coup-if-not (fct lst / posl ret ltmp el1 el2)
    (setq posl 0)
    (repeat (length lst)
        (setq el1 (nth posl lst) el2 (nth (1+ posl) lst))
        (if (not ltmp)(setq ltmp (append ltmp (list el1))))
        (if (and el2 (apply fct (list el1 el2)))
            (setq ltmp (append ltmp (list el2)))
            (setq ret (append ret (list ltmp)) ltmp nil)
        )
        (setq posl (1+ posl))
    )
    (if ltmp (append ret (list ltmp)) ret)
)

(defun coup-if (fct lst / posl ret ltmp el1 el2)
    (setq posl 0)
    (repeat (length lst)
        (setq el1 (nth posl lst) el2 (nth (1+ posl) lst))
        (if (not ltmp)(setq ltmp (append ltmp (list el1))))
        (if (and el2 (not(apply fct (list el1 el2))))
            (setq ltmp (append ltmp (list el2)))
            (setq ret (append ret (list ltmp)) ltmp nil)
        )
        (setq posl (1+ posl))
    )
    (if ltmp (append ret (list ltmp)) ret)
)

 

Lien vers le commentaire
Partager sur d’autres sites

Je mets la mienne :

(defun cut-if-not (fun lst / loop)
  (defun loop (f l s a)
    (cond
      ((null l) (reverse a))
      ((null (cdr l)) (reverse (cons (reverse (cons (car l) s)) a)))
      ((f (car l) (cadr l)) (loop f (cdr l) (cons (car l) s) a))
      (T (loop f (cdr l) nil (cons (reverse (cons (car l) s)) a)))
    )
  )
  (loop (eval fun) lst nil nil)
)

(defun cut-if (fun lst / loop)
  (defun loop (f l s a)
    (cond
      ((null l) (reverse a))
      ((null (cdr l)) (reverse (cons (reverse (cons (car l) s)) a)))
      ((not (f (car l) (cadr l))) (loop f (cdr l) (cons (car l) s) a))
      (T (loop f (cdr l) nil (cons (reverse (cons (car l) s)) a)))
    )
  )
  (loop (eval fun) lst nil nil)
)

 

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

avec un foreach à la place du vilain repeat

(defun coup-if-not (fct lst / posl ret ltmp el2)
    (setq posl 0)
    (foreach el1 lst
        (setq el2 (nth (1+ posl) lst))
        (if (not ltmp)(setq ltmp (append ltmp (list el1))))
        (if (and el2 (apply fct (list el1 el2)))
            (setq ltmp (append ltmp (list el2)))
            (setq ret (append ret (list ltmp)) ltmp nil)
        )
        (setq posl (1+ posl))
    )
    (if ltmp (append ret (list ltmp)) ret)
)
(defun coup-if (fct lst / posl ret ltmp el2)
    (setq posl 0)
    (foreach el1 lst
        (setq el2 (nth (1+ posl) lst))
        (if (not ltmp)(setq ltmp (append ltmp (list el1))))
        (if (and el2 (not(apply fct (list el1 el2))))
            (setq ltmp (append ltmp (list el2)))
            (setq ret (append ret (list ltmp)) ltmp nil)
        )
        (setq posl (1+ posl))
    )
    (if ltmp (append ret (list ltmp)) ret)
)

 

Lien vers le commentaire
Partager sur d’autres sites

On 05/04/2021 at 11:47, Fraid said:

je crois que j’atteins mes limites (temporaires) d'abstraction

par contre Gile nous à fait un "reversing" renversant 

Oui justement, ça me laisse perplexe car j'en ai pas eu besoin dans ma version récursive, mais j'avoue que sa fonction est plus efficiente que ma proposition, ça doit tenir à une question de style, je vais essayer de me dégager un peu de temps d'ici mardi soir pour opter pour une réécriture dans style un peu plus efficient, merci à (gile)

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

en déplaçant des setq , pas sur que se soit plus véloce.

(defun coup-if-not (fct lst / posl ret ltmp el2)
    (setq posl -1)
    (foreach el1 lst
        (if (not ltmp)(setq ltmp (list el1)))
        (if (and (setq el2 (nth (1+ (setq posl (1+ posl))) lst))(apply fct (list el1 el2)))
            (setq ltmp (append ltmp (list el2)))
            (setq ret (append ret (list ltmp)) ltmp nil)
        )
    )
    (if ltmp (append ret (list ltmp)) ret)
)
(defun coup-if (fct lst / posl ret ltmp el2)
    (setq posl -1)
    (foreach el1 lst
        (if (not ltmp)(setq ltmp (list el1)))
        (if (and (setq el2 (nth (1+ (setq posl (1+ posl))) lst)) (not(apply fct (list el1 el2))))
            (setq ltmp (append ltmp (list el2)))
            (setq ret (append ret (list ltmp)) ltmp nil)
        )
    )
    (if ltmp (append ret (list ltmp)) ret)
)

Suppression d'un append inutile

Modifié par Fraid
Lien vers le commentaire
Partager sur d’autres sites

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é.

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Tes premières versions avec la "fonction lambda enveloppante" est vraiment très élégante.
Personnellement, je n'ai pas trop cherché plus loin que ce premier jet (surtout depuis que tu as dit que ma solution était plus efficiente). Je me suis juste dit, dans un souci d'efficience : 1. éviter append (reverse ne cout vraiment pas cher), 2. ne faire le (eval fun) qu'une fois au début.

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

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:

18 hours ago, VDH-Bruno said:

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.

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  

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

3 hours ago, VDH-Bruno said:

append est moins efficient que un reverse + cons

parce que cons ne fait qu'ajouter un élément à une liste déjà existante en mémoire et que append (mal implémenté) reconstruit intégralement toutes les listes qui lui sont passées.

_$ (setq l0 '(1 2 3))
(1 2 3)
_$ (setq l1 (cons 0 l0))
(0 1 2 3)
_$ (setq l2 (append '(0) l0))
(0 1 2 3)
_$ (eq (cdr l1) l0)
T
_$ (eq (cdr l2) l0)
nil

 

3 hours ago, VDH-Bruno said:

En conclusion la récursivité est utile mais pas indispensable, mais utile 😉.

La récursivité est incontournable quand on traite des structures récursives comme les arborescences (un répertoire est un dossier qui peut contenir des fichiers et des répertoires). Et si on ne l'utilise pas systématiquement, la comprendre est à mon avis indispensable pour comprendre intimement le LISP qui est un langage fondamentalement récursif :
Un programme LISP est une liste d'expressions LISP
Une expression LISP est soit un atome ; soit une liste d'expressions LISP.

Idem pour les listes chainées en LISP (CF ce sujet).

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

44 minutes ago, (gile) said:

La récursivité est incontournable quand on traite des structures récursives comme les arborescences (un répertoire est un dossier qui peut contenir des fichiers et des répertoires). Et si on ne l'utilise pas systématiquement, la comprendre est à mon avis indispensable pour comprendre intimement le LISP qui est un langage fondamentalement récursif :
Un programme LISP est une liste d'expressions LISP
Une expression LISP est soit un atome ; soit une liste d'expressions LISP.

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)

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité