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

VDH-Bruno · le 2 avril 2021

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

Fraid · le 4 avril 2021

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?

(gile) · le 4 avril 2021

14 minutes ago, Fraid said:

une petite piste?

voir cette réponse, et plus loin dans le sujet une optimisation d'ElpanovEvgeniy que j'ai reprise.

(gile) · le 4 avril 2021

Ton problème ne vient pas ni de eval ni de lambda.

Le message : "; erreur: type d'argument incorrect: numberp: nil" signifie qu'une fonction qui attend un nombre et reçoit nil.

Fraid · le 4 avril 2021

bon, j'avais pourtant essayé avec apply, j'avais du m’emmêler les parenthèses.

Maintenant que cela fonctionne, je posterais du propre demain.

Fraid · le 5 avril 2021

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)
)

VDH-Bruno · le 5 avril 2021

Bravo Fraid, maintenant que ça fonctionne je pense que tu dois pouvoir optimiser le traitement😉

(gile) · le 5 avril 2021

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)
)

Fraid · le 5 avril 2021

24 minutes ago, VDH-Bruno said:

je pense que tu dois pouvoir optimiser le traitement

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

par contre Gile nous à fait un "reversing" renversant

Fraid · le 5 avril 2021

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)
)

VDH-Bruno · le 5 avril 2021

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)

VDH-Bruno · le 5 avril 2021

58 minutes ago, Fraid said:

avec un foreach à la place du vilain repeat

Oui c'est mieux, mais dans le traitement tu peux facilement optimiser quant je compare à ma version itérative avec foreach😊

Fraid · le 5 avril 2021

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é le 5 avril 2021 par Fraid

VDH-Bruno · le 5 avril 2021

Re,

1 hour ago, Fraid said:

Suppression d'un append inutile

Oui c'est plus dans cette direction, en trouvant le moyen de tous les supprimer...

VDH-Bruno · le 6 avril 2021

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

(gile) · le 6 avril 2021

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.

Fraid · le 7 avril 2021

Bonjour,

Je vais retenir principalement qu'append est moins efficient que reverse + cons.

C'est pas évidant de prime abord.

Bruno, à tu fait les testes avec une très grande liste?

VDH-Bruno · le 7 avril 2021

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

(gile) · le 7 avril 2021

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

VDH-Bruno · le 7 avril 2021

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)

Connexion

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

Messages recommandés

VDH-Bruno

Fraid

(gile)

(gile)

Fraid

Fraid

VDH-Bruno

(gile)

Fraid

Fraid

VDH-Bruno

VDH-Bruno

Fraid

VDH-Bruno

VDH-Bruno

(gile)

Fraid

VDH-Bruno

(gile)

VDH-Bruno

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante