Rechercher dans la communauté
Affichage des résultats pour « challenge » dans sujets.
-
Vui en effet je pensais avoir clarifier ce point ^^" Donc dans l'idée il faut une fonction avec un seul argument correspondant à l'ename ou vla-object de la polyligne et le retour doit être sous forme de liste de point : ( (X1 Y1) (X2 Y2) ... (Xn-1 Yn-1) (Xn Yn) )avec n le nombre de sommets, l'indice 1 correspondant au point de départ de la polyligne, l'indice n correspondant au point d'arrivée de la polyligne. La sélection de la polyligne sera donc fait en amont par le biais d'une variable pour tester :3 En effet, le but de ce challenge c'est d'essayer de trouver plusieurs façons de faire en cherchant à approfondir les recherches au maximum. Chacun de nous à une manière de penser qui nous est propre (méthode itérative ou récursive par exemple), des fonctions de prédilection, etc. Donc ici le but étant de sortir des sentiers battus justement pour forcer les développeurs à se renseigner sur d'autres fonctions qu'ils n'ont pas l'habitude d'utiliser, de chercher les optimisations pour limiter les boucles, etc. Donc quoi de mieux pour cela que de prendre une fonction très simple qui permet un nombre d'alternatives très important ! Bien trop souvent on a nos habitudes de langage et on reste dans notre zone de confort, j'aimerais juste en sortir de cette zone pour apprendre différentes logiques, fonctions, réflexions, ... Après je me pose tout de même la question si en terme de retour on ne peut pas élargir un peu les possibilités comme des SafeArray (certains programmes, selon qu'ils soient en AutoLISP vanilla, en Visual LISP ou même VBA ne gèrent pas les listes de la même manières) donc il se peut que pour un programme en Visual, la conversion d'un SafeArray en liste pour ensuite convertir cette liste en SafeArray pour continuer un autre programme ne fasse pas grand sens... >w< Donc en résumé on va dire : (defun func_name (ObjName / ...) ... ) command: (setq name (car (entsel))) ; ou (vlax-ename->vla-object (car (entsel))) command: (func_name name) ((12.4 584.5) (123.8 1.7) (12.8 967.4)) ; ou #<safearray...> équivalent à (vlax-safearray->list #<safearray...>) = ((12.4 584.5) (123.8 1.7) (12.8 967.4)) Bisous, Luna
-
Bonjour, Pour répondre à une demande sur un forum j'ai été amené à créer ce code. La demande portait sur le raccordement aux extrémités seulement de plusieurs polylignes (composées essentiellement de segments droits) se touchant à leurs extrémités mais étant sur des calques différents, par un rayon identique. Ce raccord d'arc devait être composé en deux parties pour rejoindre le calque des polylignes concernées. Bien que certainement inutile pour beaucoup (mais sait on jamais!), comme j'ai trouvé ce challenge intéressant, j'ai essayé d'y répondre. L’intéressé a été satisfait... Voici le code (des bugs peuvent subsister car moyennement testé) (defun z_dir (p1 p2 / ) (trans '(0.0 1.0 0.0) (mapcar '(lambda (k) (/ k (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) (mapcar '- p2 p1) ) ) ) ) ) (mapcar '- p2 p1) ) 0 ) ) (defun ang_x (px p1 p2 / l_pt l_d p ang) (setq l_pt (mapcar '(lambda (x) (list (car x) (cadr x) (caddr x))) (list px p1 p2)) l_d (mapcar 'distance l_pt (append (cdr l_pt) (list (car l_pt)))) p (/ (apply '+ l_d) 2.0) ang (* (atan (sqrt (/ (* (- p (car l_d)) (- p (caddr l_d))) (* p (- p (cadr l_d)))))) 2.0) ) ) (defun k_th (p1 p2 c / k) (setq k (/ c (distance p1 p2))) (mapcar '+ (mapcar '* (mapcar '- p2 p1) (list k k k)) p1) ) (defun c:Spec_Fillet ( / js n ent lo_pt l_pt pt l3 js1 js2 alpha l_tg p_o a1 a2 dxf_210) (cond ((not (zerop (getvar "FILLETRAD"))) (setq js (ssget '((0 . "LWPOLYLINE") (67 . 0)))) (cond (js (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) lo_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent))) lo_pt (list (car lo_pt) (last lo_pt)) lo_pt (mapcar '(lambda (z) (trans z 0 1)) lo_pt) ) (if (null l_pt) (mapcar '(lambda (x) (setq l_pt (cons x l_pt))) lo_pt) (foreach el lo_pt (if (null (vl-remove-if-not '(lambda (x) (equal el x 1E-08)) l_pt)) (setq l_pt (cons el l_pt)) ) ) ) ) ) ) (cond (l_pt (while l_pt (setq pt (car l_pt) js (ssget "_C" (mapcar '- pt '(0.05 0.05 0.0)) (mapcar '+ pt '(0.05 0.05 0.0)) '((0 . "LWPOLYLINE") (67 . 0))) ) (cond ((and js (eq (sslength js) 2)) (setq l3 (list pt)) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) lo_pt (mapcar '(lambda (z) (trans z 0 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent)))) ) (cond ((and (> (length lo_pt) 2) (equal pt (car lo_pt) 1E-08)) (setq lo_pt (list (car lo_pt) (cadr lo_pt))) ) ((and (> (length lo_pt) 2) (equal pt (last lo_pt) 1E-08)) (setq lo_pt (list (last lo_pt) (nth (- (length lo_pt) 2) lo_pt))) ) ) (setq lo_pt (vl-remove-if-not '(lambda (x) (not (equal pt x 1E-08))) lo_pt) l3 (append l3 lo_pt) ) (set (read (strcat "js" (itoa (1+ n)))) (entget ent)) ) (setq alpha (ang_x (car l3) (cadr l3) (caddr l3)) ) (cond ((not (equal alpha pi 1E-06)) (setq l_tg (* (getvar "FILLETRAD") (/ 1.0 (/ (sin (* alpha 0.5)) (cos (* alpha 0.5))))) p_o (k_th (car l3) (mapcar '* (mapcar '+ (polar (car l3) (angle (car l3) (cadr l3)) l_tg) (polar (car l3) (angle (car l3) (caddr l3)) l_tg) ) '(0.5 0.5 0.5) ) (+ (getvar "FILLETRAD") (* (getvar "FILLETRAD") (1- (/ 1.0 (sin (* alpha 0.5)))))) ) a1 (angle p_o (car l3)) a2 (angle p_o (polar (car l3) (angle (car l3) (cadr l3)) l_tg)) dxf_210 (z_dir p_o (car l3)) ) (if (or (zerop a2) (and (eq (rem a1 (* 3.5 pi)) a1) (> a1 a2))) (setq a2 (+ a2 (* 2 pi))) ) (entmake (list (cons 0 "ARC") (cons 100 "AcDbEntity") (assoc 67 js2) (assoc 410 js2) (assoc 8 js2) (if (assoc 62 js2) (assoc 62 js2) (cons 62 256)) (if (assoc 6 js2) (assoc 6 js2) (cons 6 "BYLAYER")) (if (assoc 370 js2) (assoc 370 js2) '(370 . -1)) (cons 38 (+ (cdr (assoc 38 js2)) (getvar "ELEVATION"))) (cons 39 (getvar "THICKNESS")) (cons 100 "AcDbCircle") (cons 10 (trans p_o 1 dxf_210)) (cons 40 (getvar "FILLETRAD")) (cons 210 dxf_210) (cons 100 "AcDbArc") (cons 50 (if (and (< a1 a2) (<= (- a2 a1) pi)) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a1) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a2))) (cons 51 (if (and (< a1 a2) (<= (- a2 a1) pi)) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a2) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a1))) ) ) (setq a2 (angle p_o (polar (car l3) (angle (car l3) (caddr l3)) l_tg)) ) (if (or (zerop a2) (and (eq (rem a1 (* 3.5 pi)) a1) (> a1 a2))) (setq a2 (+ a2 (* 2 pi))) ) (entmake (list (cons 0 "ARC") (cons 100 "AcDbEntity") (assoc 67 js1) (assoc 410 js1) (assoc 8 js1) (if (assoc 62 js1) (assoc 62 js1) (cons 62 256)) (if (assoc 6 js1) (assoc 6 js1) (cons 6 "BYLAYER")) (if (assoc 370 js1) (assoc 370 js1) '(370 . -1)) (cons 38 (+ (cdr (assoc 38 js1)) (getvar "ELEVATION"))) (cons 39 (getvar "THICKNESS")) (cons 100 "AcDbCircle") (cons 10 (trans p_o 1 dxf_210)) (cons 40 (getvar "FILLETRAD")) (cons 210 dxf_210) (cons 100 "AcDbArc") (cons 50 (if (and (< a1 a2) (<= (- a2 a1) pi)) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a1) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a2))) (cons 51 (if (and (< a1 a2) (<= (- a2 a1) pi)) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a2) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a1))) ) ) ) ) ) ) (setq l_pt (cdr l_pt)) ) ) ) ) (T (princ "\nFILLETRAD doit être différent de zéro")) ) (prin1) )
-
Bonjour @(gile) @VDH-Bruno Votre "bravo" me touche, je vous remercie sincèrement. En effet, je me suis un peu tracassé la tête, on trouve encore la trace de mon "impérativité" dans les définitions de L3,L4... De toute façon j'ai un résultat qui me plaît, maintenant s'il plaît aux autres et qu'il est efficient c'est "la cerise sur le ponpon". On se met d'accord pour le prochain challenge au niveau du dépôt des réponses, ça marche ? Je ne suis pas certain du tout de participer au prochain, car le sujet me parle ou pas et décide de mon implication (si je sens que je peux répondre in fine) À tous : Il est possible que je dédie une page de "da-code" à ces sujets, ai-je l'autorisation de vous citer et d'intégrer votre code ? Amicalement PS: Je dois vous quitter car il faut que je cherche des pokemon à imprimer pour faire du coloriage, on n'a pas une vie facile ...
-
(je vais me faire insulter mais c'est pas grave je vais le dire quand meme : ) Le F# Me fait pensé un peu au VBA / VB.NET c'est rigolo ^^ Si la démo de didier sur ces 10.000 points est rapide comme ça... le vba ne fera pâs mieux ! par contre je vais aller au bout de ce challenge et vous donnez du coup le temps nécessaire au code VBA pour traiter 10.000 point voir plus ! parce que la effectivement je pense qu'on pourra comparer "l'efficience de deux code" J'ai des entetiens a préparer, un véhicule à retaper donc je le ferais pas de suite mais je le ferais !
-
Coucou Ça y est je livre et me délivre, c'est tellement rare que je participe à un challenge... Exécution : le sablier flashe à partir de dix mille points Rendu : Code : avec commentaires (je demanderais volontiers aux autres de faire de même pour la formation des lecteurs) Amicalement (defun da:horaire (a b c / ) ;| calcul de la superficie du triangle qui est négative si les sommets tournent en sens horaire http://mathforum.org/library/drmath/view/54386.html (0.5)(x1*y2 - y1*x2 -x0*y2 + y0*x2 + x0*y1 - y0*x1) |; (minusp (* (- (+ (+ (- (- (* (car b) (cadr c))(* (cadr b) (car c)))(* (car a) (cadr c)))(* (cadr a) (car c)))(* (car a) (cadr b)))(* (cadr a) (car b)))0.5)) );fin defun da:horaire (defun da:makepoly2d (lstpt2d);dessin d'une poly 2D depuis une liste de points ((x1 y1)...(xn yn)) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lstpt2d)) '(70 . 1) ;1 pour fermée, 0 pour ouverte ) (mapcar '(lambda (p) (cons 10 p)) lstpt2d) ) ) (princ) );fin de da:makepoly2d ;fonction principale qui attend en unique argument une liste de points ((x1 y1 z1)...(xn yn zn)) (defun daqh (lstpt / l3 l4 l5 l6 ldalsthull lstpt pt ptpi) ; tri par Y croissants (setq lst (vl-sort lstpt '(lambda(a b) (if (eq (cadr a) (cadr b))(< (car a) (car b))(< (cadr a) (cadr b)))))) ; point avec le plus petit Y, point pivot (setq ptpi (car lst)) ; liste des angles depuis pivot depuis l'axe des X (setq lda (mapcar '(lambda (X Y) (angle ptpi y)) (reverse (cdr (reverse lst))) (cdr lst))) ;création liste des points avec la valeur d'angle en premier (angle x y z) (setq l3 (mapcar 'cons lda (cdr lst))) ; tri par premier élément de la liste "angle" (setq l4 (vl-sort l3 '(lambda(a b) (if (eq (cdr a) (cdr b))(< (car a) (car b))(< (car a) (car b)))))) ;liste des points triés en retirant l'angle en premier élément pour n'avoir que des points (x y z) (setq l5 (mapcar 'cdr l4)) ;rajout du point pivot dans la liste des points (setq l6 (cons ptpi l5)) (setq lsthull (list (cadr l6) (car l6))) ;liste sans les deux premiers points (setq l6 (cddr l6)) ;test sens horaire (foreach ptemp l6 (while (and (cdr lsthull) (da:horaire (cadr lsthull) (car lsthull) ptemp)) (setq lsthull (cdr lsthull)) ) (setq lsthull (cons ptemp lsthull)) ) ;(setq zaza (reverse lsthull)) ;suppression des z dans la liste des points (setq lsthull (mapcar '(lambda (pt) (list (car pt) (cadr pt))) (reverse lsthull))) ;dessin de la poly 2D d'enveloppe (da:makepoly2d lsthull) );fin defun daqh ;fonction pour test qui demande un choix de points filtré sur entité POINT (defun c:TestdaQH ( / ss lstpt n) (prompt "\nChoix des points à cerner...\n") (setq ss (ssget (list '(0 . "POINT")))) (repeat (setq n (sslength ss)) (setq lstpt (cons (cdr (assoc 10 (entget (ssname ss (setq n (1- n))))))lstpt)) ) (daqh lstpt) );fin de c:TestdaQH (prompt "\nTaper Testdaqh pour trouver l'enveloppe convexe des points\n") (princ) Amicalement
-
Super, ça démarre. @didier C'est pas grave si des réponses commencent à arriver, ce n'est pas un concours il s'agit juste d'apprendre en comparant différentes façon de faire et il me semble qu'il reste de place pour bien d'autres réponses. J'attendrai la tienne pour poster ma réponse en LISP. @VDH-Bruno Bravo, ça répond tout à fait à la demande. Je suis sûr que si tu as le temps tu pourras "optimiser" ta routine (ma réponse en LISP est proche de la tienne, mais plus concise). @Fraid Ça ne répond pas tout à fait à la demande donc on ne peut pas comparer directement avec les autres réponses et on est assez loin de l'algorithme du quicksort. En tout cas, c'est pas vraiment 'quick'. J'ai eu un peu peur quand vous parliez de "nuage de points", avec ta solution, il y a intérêt à ce que ce soit un cirrus de beau temps. Suivant la tâche à accomplir, certains langages sont plus ou moins bien adaptés. Dans ce cas là, parmi les langages que je connais F# est certainement le plus adapté. Je ne pense pas "divulgacher" le challenge en donnant une réponse en F# maintenant. let quickhull (pts: Point2d list) = let area (p1: Point2d) (p2: Point2d) (p3: Point2d) = ((p2.X - p1.X) * (p3.Y - p1.Y)) - ((p2.Y - p1.Y) * (p3.X - p1.X)) let rec rightPts p1 p2 min acc = function | [] -> acc | x :: xs -> match area p1 p2 x with | a when 0. <= a -> rightPts p1 p2 min acc xs | a -> match acc with | [] -> rightPts p1 p2 a [x] xs | y :: ys -> if a < min then rightPts p1 p2 a (x :: acc) xs else rightPts p1 p2 min (y :: x :: ys) xs let rec loop p1 p2 pts = match rightPts p1 p2 0. [] pts with | [] -> [p1] | h :: t -> loop p1 h t @ loop h p2 t let minX = pts |> List.minBy (fun p -> p.X) let maxX = pts |> List.maxBy (fun p -> p.X) loop minX maxX pts @ loop maxX minX pts
-
Bonjour, Je me permet de poster mais c'est tellement brut, que cela répond au challenge que part son résultat. pas son algorithme "Viking" (defun Quickhull (lpt / acdc mods oldosmode oldcmdecho lptmp ptrec zone sel ob ct) (vla-zoomextents (vlax-get-acad-object)) (setq acdc (vla-get-activedocument (vlax-get-acad-object)) mods (vla-get-modelspace acdc) oldosmode (getvar 'osmode) oldcmdecho (getvar 'cmdecho) zone (coordaffichage) lptmp (cdr lpt) ) (setvar 'osmode 0) (setvar 'cmdecho 0) (foreach pt1 lpt (foreach pt2 lptmp (vla-AddLine mods (vlax-3d-point (car pt1)(cadr pt1) 0) (vlax-3d-point (car pt2)(cadr pt2) 0)) ) (setq lptmp (cdr lptmp)) ) (setq ptrec (vlax-make-safearray vlax-vbDouble '(0 . 14))) (vlax-safearray-fill ptrec (list (1-(caar zone)) (1-(cadar zone)) 0 (1-(caar zone)) (1+(cadadr zone)) 0 (1+(caadr zone)) (1+(cadadr zone)) 0 (1+(caadr zone)) (1-(cadar zone)) 0 (1-(caar zone)) (1-(cadar zone)) 0 ) ) (vla-AddPolyline mods ptrec) (vla-zoomextents (vlax-get-acad-object)) (vla-regen acdc acActiveViewport) (vl-cmdf "_.-boundary" (car zone) "") (setq sel (ssget "_x" (list (cons 0 "*POLYLINE"))) ct -1) (while (setq ob (ssname sel (setq ct (1+ ct)))) (if (/= ct 1)(vla-delete (vlax-ename->vla-object ob))) ) (setq sel (ssget "_x" (list (cons 0 "LINE"))) ct -1) (while (setq ob (ssname sel (setq ct (1+ ct)))) (vla-delete (vlax-ename->vla-object ob)) ) (setvar 'osmode oldosmode) (setvar 'cmdecho oldcmdecho) (princ) ) (defun coordaffichage ( / viewctr viewsize screensize) (mapcar 'set '(viewctr viewsize screensize) (mapcar 'getvar '(viewctr viewsize screensize))) ((lambda (dimxy) (list (mapcar '- viewctr dimxy) (mapcar '+ viewctr dimxy))) (list (* viewsize (/ (car screensize) (cadr screensize) 2.)) (/ viewsize 2) 0.0) ) ) et un test un peux différent, puisque je dessine la polyligne (defun c:test (/ ss i pts) (if (setq ss (ssget '((0 . "point")))) (progn (repeat (setq i (sslength ss)) (setq pts (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) pts ) ) ) (quickhull pts) ) ) (princ) )
-
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 Ah zut de zut Quelqu'un a répondu ! Pour une fois que je me mettais dans un challenge que j'avais compris ! (car les listes triées deux à deux dans l'ordre alphabétique hébreu médiéval avec quelques chiffres, très peu pour moi, ça ne me parle guère) Allez j'attends encore un peu pour peaufiner ma version et je dépose. Je pense que pour les prochains il faut donner une date de dépôt, qu'on le veuille ou non on lit les réponses, dans le cas présent j'ai sauté le message de @VDH-Bruno mais il existe et ça devrait pas pour l'égalité des chances. Amicalement
-
Outre que je ne vois pas bien le rapport avec ce challenge, cet algorithme n'est pas fiable à 100%. Tu n'envisages pas le cas où la droite passe par un sommet (point vert) ou deux sommets (point jaune), ni celui où elle est tangente à un arc (point rouge). Dans ces trois cas, les points sont à l'intérieur mais la droite a 3 intersections... Ça m'a toujours intrigué cette tendance à la verbosité dans la culture VB : Point_dans_Polyligne = False If NbrePoints Mod 2 = 0 Then Point_dans_Polyligne = False Else Point_dans_Polyligne = True End If Alors qu'on devrait pouvoir écrire tout simplement : Point_dans_Polyligne = NbrePoints Mod 2 <> 0
-
T'inquiète, c'est juste pour éviter de dessiner une volée cela ne résous en rien le challenge
-
Le but du challenge est de fournir une fonction qui prends en argument une collection de points 2D (je conseille des commencer avec une ou quelques dizaines de points pas plus) et qui renvoie les points qui constituent l'enveloppe convexe de cette collection. J'ai implémenté ce type de fonction en utilisant l'algorithme dit du parcours de Graham (en C# et F# ainsi qu'en LISP : gc:ConvHull dans MathGeom sur cette page). Je proposais de le faire avec ici avec QuickHull, mais après tout, toute solution est bienvenue.
-
Bonjour, Si il y a un argument en plus qui est la "résolution" (longueur max des faces du polygone) je sais faire. Mais sans, je ne vois pas comment déterminer si on doit rejoindre ou non un point...surtout si on a une volée en forme de croissant. Notamment avec l'algorithme que tu nous présente au début du message. Avant que tu poste ce challenge, je commençais à reprendre mon lisp qui me donne un profil dans un nuage de points. (l'outil Autocad est vraiment inutile...) en essayant d'intégrer l'algo que tu avais posté sur theswamp. du coup, il me semble que c'est la solution non?
-
[Challenge] Fonction "d'ordre supérieur"
VDH-Bruno a répondu à un(e) sujet de VDH-Bruno dans Pour aller plus loin en LISP
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é. -
Il y a 10 types de personnes dans le monde : celles qui comptent en binaire et les autres
(gile) a répondu à un(e) sujet de (gile) dans Débuter en LISP
Je parlais d'autres environnements dans lesquels la couleur et la transparence sont exprimées en ARGB où A est le canal Alpha qui représente la transparence. De la même manière que pour le RGB, ça permet de stocker et de retrouver facilement 4 valeurs dans un seul nombre qu'on écrit le plus souvent en hexadécimal ce qui rend la décomposition entre les 4 canaux immédiatement visible : #80FF0000 est un rouge (R = 255, G = 0 B = 0) avec 50% de transparence (A = 128). La notation montrée dans le premier message, est appelé "notation en complément à 2". Elle est cohérente quand on utilise un nombre de bits déterminé (ici 32). Elle permet que l'addition d'un nombre positif et d'un nombre négatif soit juste parce qu'on ignore les dépassements (au delà du bit 31) 1 + -1 = 0 : 0 0 0 0 ... 0 0 0 1 + 1 1 1 1 ... 1 1 1 1 = 0 0 0 0 ... 0 0 0 0 En résumé, si on veut faire des opérations bit à bit sur les nombres, on utilise les fonctions décrites ci-dessus qui sont prévues pour ça. De ce côté là AutoLISP est aussi bien équipé que les autres langages de programmation. Essayer de transcrire en opérations arithmétiques sur les décimaux certaines des opérations bit à bit relèverait plus du challenge. -
[challenge] String pour injection
VDH-Bruno a répondu à un(e) sujet de Fraid dans Programmer en s'amusant
Bonjour Fraid, Pour ma part ce n'était pas un problème de passion, juste que le challenge proposé faisait appel à des connaissances que je n'avais pas sur le sujet, donc j'avoue que pour participer cela m'aurait demandé un peu (beaucoup) de recherche pour que je puisse me mettre au niveau de la difficulté à relever. Sur ce coup, j'ai préféré passer mon tour une prochaine fois peut-être. Personnellement je te remercie tout de même de l'avoir posé car qui sait si un jour je veux jouer avec des url ce post sera une bonne base de départ. Salutations Bruno -
[challenge] String pour injection
Fraid a répondu à un(e) sujet de Fraid dans Programmer en s'amusant
Ok, tu t'éloigne un petit peu. On s’occupe que de la partie injection. (après le dernier / ) dans l'absolue, si on encode tous les caractères, c'est évidement accepté par le serveur. Mais la, le but, est de garder une lisibilité par un être humain de l'injection. Je vais reformuler le challenge en oubliant le javascript. Convertir les caractères spéciaux excepté "- _ . ! ~ * ' ( )" en caractères hexadécimal pour UTF-8 voir lien donné à Luna + haut. -
[challenge] String pour injection
Fraid a répondu à un(e) sujet de Fraid dans Programmer en s'amusant
bonjour Luna un petit lien pour comprendre caracteres et oui, ce challenge demande un peu de recherche -
[Challenge] Grouper des points
(gile) a répondu à un(e) sujet de (gile) dans Programmer en s'amusant
Ces challenges ne poussent pas toujours à prendre du recul ni à faire les choses sereinement. On a un peu tendance à se focaliser (parfois avec des œillères) sur le problème posé (surtout quand il est mal posé comme ici) et à vouloir y répondre vite (avant les autres) en privilégiant la concision, l'élégance, l'efficience. C'est le jeu, et je m'y suis laissé prendre avec plaisir plus souvent qu'à mon tour. Là j'ai le beau rôle en lançant ce challenge avec une réponse quasiment toute faite à partir de fonctions écrites depuis longtemps. Mais, si je peux me permettre de tirer "la morale de cette histoire" ça serait : 1. Quand on est face à un problème "complexe" il faut essayer de le décomposer en plusieurs problèmes plus simples (et plus facile à résoudre et à tester séparément). 2. Quand on résout un problème, essayer de généraliser la solution afin qu'elle puisse resservir pour d'autres problèmes (une fonction de groupage générique peut avoir de nombreuses autres utilités). -
Bon ben, je vais avoir du travail pour étudier tout chat et comprendre la logique parce que ya pas à dire, c'est propre ! C'est une leçon très intéressante quoi qu'il en soit et qui démontre parfaitement l'importance de la logique appliquée par le développeur pour arriver à ses fins. Les routes sont nombreuses pour arriver à ses fins mais une bonne connaissance du chemin permet d'emprunter des raccourcis facilitant une utilisation généralisée (mais pouvant créer des nœuds au cerveau parfois !). J'avais justement essayé un développement similaire au début mais je me suis ratée sur la génération des clés de recherche, donc après quelques nœuds au cerveau, j'ai préférer me rabattre sur une logique plus...analytique mais avec cela, j'aurais de quoi apprendre à mieux les utiliser car cela peut servir en de nombreuses occasions ! Donc merci pour ce challenge et pour vos réponses à tous ! Bisous, Luna
-
[Challenge] Grouper des points
(gile) a répondu à un(e) sujet de (gile) dans Programmer en s'amusant
Les langages mieux lotis que le LISP pour traiter des données fournissent souvent une méthode de groupage des données (SQL, .NET avec Ling, F# avec les listes et séquences, ...). Ces méthodes permettent de grouper les données à l'aide d'une clé (souvent une propriété du type de donnée ou un champ dans une base de données). Comme je suis un gros paresseux (et que je répondais à une demande sur le forum .NET), c'est cette route que j'ai emprunté. Il ne restait plus qu'à trouver comment générer une clé de groupage pour des nombres : en arrondissant à la valeur de la tolérance. F# est, hormis AutoLISP, mon langage de prédilection pour prototyper. il existe une fonction native groupBy et une fonction round mais celle-ci arrondi à la valeur entière la plus proche. La méthode .NET System.Math.Round qui accepte en second argument un entier pour spécifier le nombre de décimale ne fait pas directement mon affaire. Qu'à cela ne tienne on écrit une petite fonction au multiple le plus proche. let roundTo multiple value = round (value / multiple) * multiple On utilise ensuite cette fonction pour grouper les points : let groupPointsByX tolerance (pts: Point2d list) = pts |> List.groupBy (fun p -> roundTo tolerance p.X) Si on veut grouper par X et Y, il suffit de modifier la fonction de groupage : let groupPointsByXY tolerance (pts: Point2d list) = pts |> List.groupBy (fun p -> roundTo tolerance p.X, roundTo tolerance p.Y) Vous pouvez tester tout ça sans rien installer avec Try F#. On va maintenant transcrire tout ça dans un langage moins confidentiel. AutoLISP ne fournit pas de fonction pour arrondir les nombres mais ça a été fait maintes fois (il me semble que ça avait l'objet d'un challenge il a quelque temps maintenant). De même, pour arrondir au multiple le plus proche rien de bien sorcier (CF ci-dessus). Reste la fonction de groupage. Avec AutoLISP pour grouper des valeurs en s'inspirant de ce qui se fait ailleurs, on utiliserait une liste d'association (le premier élément de chaque sous liste est la "clé"). Pour ne pas refaire le boulot à chaque fois, il peut-être intéressant de définir une fonction groupBy "générique" qui pourrait resservir dans dans d'autres cas. Cette fonction devra être une fonction dite "d'ordre supérieur" à savoir une fonction qui en prend une autre en argument (comme apply, mapcar, vl-remove-if, ...). En fait, tout ça existait déjà dans les bibliothèques MathGeom.lsp et List.lsp en bas de cette page. Donc je ne me suis pas foulé : ;; gc:round ;; Arrondit à la valeur entière la plus proche ;; ;; Arguments ;; num : le nombre à arrondir (defun gc:round (num) (if (minusp num) (fix (- num 0.5)) (fix (+ num 0.5)) ) ) ;; gc:roundTo ;; Arrondit au multiple de prec le plus proche ;; ;; Arguments ;; prec : le nombre spécifiant la précision de l'arrondi ;; num : le nombre à arrondir (defun gc:roundTo (prec num) (if (zerop (setq prec (abs prec))) num (* prec (gc:round (/ num prec))) ) ) ;; gc:groupBy ;; Regroupe les éléments d'une liste selon la clé générée par la fonction spécifiée. ;; Retourne un liste de sous listes dont le premier élément est la clé. ;; ;; Arguments ;; fun : la fonction génératrice de clé ;; lst : la liste (defun gc:groupBy (fun lst / f key sub res) (setq f (eval fun)) (foreach n lst (setq res (if (setq sub (assoc (setq key (f n)) res)) (subst (cons key (cons n (cdr sub))) sub res) (cons (list key n) res) ) ) ) ) Et ensuite : (defun grouperPointsParX (tol pts) (gc:groupBy '(lambda (p) (gc:roundTo tol (car p))) pts) ) (defun grouperPointsParXY (tol pts) (gc:groupBy '(lambda (p) (list (gc:roundTo tol (car p)) (gc:roundTo tol (cadr p))) ) pts ) ) Les listes renvoyées sont des listes d'association avec comme premier élément de chaque sous liste la valeur du multiple (ou de la paire de multiples), ce qui pourrait être utile pour des recherches ultérieures ou être facilement supprimé par un (mapcar 'cdr ...). ( (-10.0 (-6.6 4.7) (-13.6 7.5) (-6.3 14.2) (-14.3 14.3)) (0.0 (2.4 -4.9) (-1.9 -3.2) (4.8 0.7)) (10.0 (6.6 11.2) (9.3 4.7) (8.0 0.9) (14.4 4.7)) ) ( ((-10.0 10.0) (-13.6 7.5) (-6.3 14.2) (-14.3 14.3)) ((10.0 10.0) (6.6 11.2)) ((-10.0 0.0) (-6.6 4.7)) ((0.0 0.0) (2.4 -4.9) (-1.9 -3.2) (4.8 0.7)) ((10.0 0.0) (9.3 4.7) (8.0 0.9) (14.4 4.7)) ) -
Petite erreur de syntaxe sur car si on définit un écart de 10, on aurait plutôt [-14.3, -4.3[, [-4.3, 5.7[, [5.7, 15.7[ ... Bon aller j'y retourne en essayant de répondre au challenge de manière plus générale (probablement plus longue aussi) T_T Bisous, Luna
-
Coucou, Grâce à la nouvelle structure du site, je viens de découvrir ce forum :3 Ce n'est pas très opti' mais voici ma première proposition au challenge : (defun mergepts (pt-list fuzz / mn i lst grp) (defun grouppts (pt-list fuzz / lst) (setq lst (list (vl-remove-if '(lambda (pt) (< (+ mn fuzz) (car pt))) pt-list) (vl-remove-if-not '(lambda (pt) (< (+ mn fuzz) (car pt))) pt-list) ) ) ) (setq mn (apply 'min (mapcar 'car pt-list)) i 0 ) (while pt-list (setq grp (grouppts pt-list (* (setq i (1+ i)) fuzz)) lst (cons (car grp) lst) pt-list (cadr grp) ) ) (reverse lst) ) Bisous, Luna
-
[Challenge]Paramètres de l'ellipse
didier a répondu à un(e) sujet de (gile) dans Programmer en s'amusant
Bonjour (gile) Je n'ai pas bien compris l'intérêt du challenge si c'est pour créer une fonction qui calcule un paramètre existant puisque tu sélectionnes une entité ELLIPSE C'est pour ça que j'ai choisi de cliquer des points et ensuite, avec ces points, sans ellipse donc, trouver le paramètre qui correspond à l'angle désigné Je vais reprendre ce que j'ai fait avec le ENTMAKE mais il me semble que c'est ce que tu montres à suivre... Merci de nous avoir chamboulé la tête 😃 Je pense que pour les prochains challenges il faudrait s'entendre sur une date de dépôt des solutions car voir les solutions arriver n'est pas sans augmenter la pression et peut faire prendre des chemins de traverse, non ? Amicalement -
[Challenge]Paramètres de l'ellipse
(gile) a répondu à un(e) sujet de (gile) dans Programmer en s'amusant
@Fraid Ça ne serait pas un challenge. Il ne s'agit pas forcément des paramètres ou angle de départ ou de fin, mais de convertir en angle n'importe quel paramètre de l'ellipse ou inversement.
