optimisation de barre

[PHILPHIL]

bonjour

avez vous un algorithme sous LISp pour optimiser des barres.

soit une liste de longueurs et handle d'objet  et une longueur de barres

but du lisp faire des  listes  regroupant les ( longueur, handle ) en optimisant les barres et minimisant les chutes.

merci

Phil

 

[(gile)]

Salut,

Un algorithme simple de bin packing en une dimension (best-fit decreasing).

(defun miseEnBarre (listeDebit lgBarre / mettreEnBarre)
  
  (defun mettreEnBarre (listeDebit lgRestante barre debitRestant)
    (cond
      ((null listeDebit)
	(cons (reverse barre)
	      (if debitRestant
		(mettreEnBarre (reverse debitRestant) lgBarre nil nil)
	      )
	)
      )
      ((<= (car listeDebit) lgRestante)
       (mettreEnBarre
	 (cdr listeDebit)
	 (- lgRestante (car listeDebit))
	 (cons (car listeDebit) barre)
	 debitRestant
       )
      )
      (T
       (mettreEnBarre
	 (cdr listeDebit)
	 lgRestante
	 barre
	 (cons (car listeDebit) debitRestant)
       )
      )
    )
  )
  
  (mettreEnBarre (vl-sort (mapcar 'float listeDebit) '>) lgBarre nil nil)
)

 

[PHILPHIL]

hello Gile

Merci

j'ai testé ton bout de lisp

j'ai ca comme données d'entrées pour tester, les "a" "b" "c"  seront dans le future les handles des blocs avec attribut que je voudrais filtrer

(defun c:testlongbarre ()
  (setq listebarre '(("a" 120.0)
                     ("d" 156.8)
                     ("b" 120.0)
                     ("c" 148.5)
                     ("e" 147.8)
                     ("f" 120.0)
                     ("g" 120.0)
                     ("n" 47.9)
                     ("o" 50.5)
                     ("r" 256.7)
                     ("s" 233.5)
                     ("t" 120.0)
                     ("af" 159.7)
                     ("ag" 256.7)
                     ("ah" 233.5)
                     ("u" 120.0)
                     ("v" 148.5)
                     ("w" 156.8)
                     ("x" 147.8)
                     ("p" 47.9)
                     ("q" 159.7)
                     ("y" 120.0)
                     ("z" 120.0)
                     ("aa" 148.5)
                     ("ab" 156.8)
                     ("ac" 147.8)
                     ("ad" 50.5)
                     ("h" 148.5)
                     ("i" 156.8)
                     ("j" 147.8)
                     ("k" 50.5)
                     ("l" 47.9)
                     ("m" 50.5)
                     ("ae" 47.9)
                    )
        lgbarre    500.0
  )
  (miseenbarre1 listebarre lgbarre)
)

 

une fois que j'aurais "resultat"  je pourrais attribuer des numéros a chaque barre ( regroupement de liste formé par ton lisp )  puis grace aux handles  aller modifier un attribut dans chaque bloc correspondant au numéro de barre.

 

donc j'ai modifie ton bout de lisp comme ceci  en pensant que comme j'ai  une liste de liste a deux entrées, je devais donc prendre la seconde entrée pour les calculs de debit, mais ca ne marche pas

(defun miseenbarre1 (listedebit lgbarre / mettreenbarre)
  (defun mettreenbarre (listedebit lgrestante barre debitrestant)
     (setq
      resultat (cond
                 ((null listedebit)
                  (cons (reverse barre)
                        (if debitrestant
                          (mettreenbarre (reverse debitrestant) lgbarre nil nil)
                        )
                  )
                 )
                 ((<= (cadr (car listedebit)) lgrestante)
                  (mettreenbarre (cadr (cdr listedebit))
                                 (- lgrestante (cadr (car listedebit)))
                                 (cons (cadr (car listedebit)) barre)
                                 debitrestant
                  )
                 )
                 (t
                  (mettreenbarre (cadr (cdr listedebit)) lgrestante barre (cons (cadr (car listedebit)) debitrestant))
                 )
               )
    )
  )
   (mettreenbarre (vl-sort listedebit
                          '(lambda (a b)
                             (if (eq (cadr a) (cadr b))
                               (< (car a) (car b))
                               (< (cadr a) (cadr b))
                             )
                           )
                 )
                 lgbarre
                 nil
                 nil
  )
)

merci

 

Phil

[(gile)]

(defun miseEnBarre (listeDebit lgBarre / mettreEnBarre)

  (defun mettreEnBarre (listeDebit lgRestante barre debitRestant)
    (cond
      ((null listeDebit)
       (cons (reverse barre)
	     (if debitRestant
	       (mettreEnBarre (reverse debitRestant) lgBarre nil nil)
	     )
       )
      )
      ((<= (cadar listeDebit) lgRestante)
       (mettreEnBarre
	 (cdr listeDebit)
	 (- lgRestante (cadar listeDebit))
	 (cons (car listeDebit) barre)
	 debitRestant
       )
      )
      (T
       (mettreEnBarre
	 (cdr listeDebit)
	 lgRestante
	 barre
	 (cons (car listeDebit) debitRestant)
       )
      )
    )
  )

  (mettreEnBarre (vl-sort listeDebit '(lambda (p1 p2) (< (cadr p2) (cadr p1)))) lgBarre nil nil)
)

Avec ta liste, (setq resultat (miseEnBarre listebarre lgbarre)) renvoie:

((("r" 256.7) ("s" 233.5))
  (("ag" 256.7) ("ah" 233.5))
  (("af" 159.7) ("q" 159.7) ("d" 156.8))
  (("w" 156.8) ("ab" 156.8) ("i" 156.8))
  (("c" 148.5) ("v" 148.5) ("aa" 148.5) ("o" 50.5))
  (("h" 148.5) ("e" 147.8) ("x" 147.8) ("ad" 50.5))
  (("ac" 147.8) ("j" 147.8) ("a" 120.0) ("k" 50.5))
  (("b" 120.0) ("f" 120.0) ("g" 120.0) ("t" 120.0))
  (("u" 120.0) ("y" 120.0) ("z" 120.0) ("m" 50.5) ("n" 47.9))
  (("p" 47.9) ("l" 47.9) ("ae" 47.9))
)

Si tu veux avoir les chutes pour chaque barre, (mapcar '(lambda (l) (- lgBarre (apply '+ (mapcar 'cadr l)))) resultat) renvoie :

(9.8 9.8 23.8 29.6 4.0 5.4 33.9 20.0 41.6 356.3)

 

Personnellement j'aurais utilisé des paires pointées plutôt que des paires, plus simples à construire  avec (cons ...) et à lire avec (cdr ...) au lieu de (cadr ...).

[PHILPHIL]

HELLO

merci Gile

Il y a 1 heure, (gile) a dit :

Personnellement j'aurais utilisé des paires pointées plutôt que des paires, plus simples à construire  avec (cons ...) et à lire avec (cdr ...) au lieu de (cadr ...).

le truc c'est que je vais surement avoir d'autre parametres qui vont rentrer en jeux,

pour le moment je teste avec des barres qui on toutes le meme diametres, ou la meme couleur, mais quand je vais rajouter un paramètre  que va donner la liste ?

je ne pourrais pas faire de paire pointé

car j'aurais ca comme liste ( handle longueur couleur ) ou ( handle longueur diametre )

il faudrait plutot que je construise ma liste comme ceci ( couleur longueur handle ) ou ( diametre longueur handle )

et avec ca je pense que ca ne marche plus, car ca ne tiens pas compte des differentes couleurs,

merci

Phil

(defun c:testlongbarre ()
(setq listebarre '(("a" 120.0 "a")
                     ("a" 156.8 "b")
                     ("a" 120.0 "c")
                     ("a" 148.5 "d" )
                     ("a" 147.8 "e")
                     ("a" 120.0 "f")
                     ("a" 120.0 "g" )
                     ("a" 47.9 "h")
                     ("b" 50.5 "i" )
                     ("b" 256.7 "j")
                     ("b" 233.5 "k")
                     ("b" 120.0 "l")
                     ("b" 159.7 "m")
                     ("b" 256.7 "n")
                     ("a" 233.5 "o")
                     ("c" 120.0 "p")
                     ("c" 148.5 "q")
                     ("c" 156.8 "r")
                     ("c" 147.8 "s")
                     ("c" 47.9 "t")
                     ("c" 159.7 "u" )
                     ("c" 120.0 "v")
                     ("c" 120.0 "x")
                     ("a" 148.5 "y")
                     ("a" 156.8 "z")
                     ("a" 147.8 "aa")
                     ("a" 50.5 "ab")
                     ("c" 148.5 "ac")
                     ("b" 156.8 "ad")
                     ("d" 147.8 "ae")
                     ("d" 50.5 "af")
                     ("d" 47.9 "ag")
                     ("d" 50.5 "ah")
                     ("d" 47.9 "ai")
                    )
        lgbarre    500.0
  )
  (setq resultat (miseenbarre listebarre lgbarre))
  (setq chute (mapcar '(lambda (l) (- lgBarre (apply '+ (mapcar 'cadr l)))) resultat))
)

[VDH-Bruno]

il y a 50 minutes, PHILPHIL a dit :

il faudrait plutot que je construise ma liste comme ceci ( couleur longueur handle ) ou ( diametre longueur handle )

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

[PHILPHIL]

hello Bruno

je vais creuser ca

ca permet que le lisp de Gile fonctionne avec deux entrées a traiter, donc de faire des paires pointés, qui irait plus vite a traiter

merci

Phil

 

[(gile)]

La question paire pointée vs liste de 2 éléments est anecdotique*.

Par contre faire des listes séparées en fonction du diamètre me semble inévitable (idem pour la couleur si les barres entières sont colorées).

 

* c'est juste que construire une liste de deux éléments avec : (list a b) correspond à : (cons a (cons b nil)) quand construire une paire pointée c'est simplement faire : (cons a b). Idem pour : (cadr p) qui correspond à : (car (cdr p))

[VDH-Bruno]

Le 06/10/2021 à 22:03, (gile) a dit :

Salut,

Un algorithme simple de bin packing en une dimension (best-fit decreasing).

(defun miseEnBarre (listeDebit lgBarre / mettreEnBarre)
  
  (defun mettreEnBarre (listeDebit lgRestante barre debitRestant)
    (cond
      ((null listeDebit)
	(cons (reverse barre)
	      (if debitRestant
		(mettreEnBarre (reverse debitRestant) lgBarre nil nil)
	      )
	)
      )
      ((<= (car listeDebit) lgRestante)
       (mettreEnBarre
	 (cdr listeDebit)
	 (- lgRestante (car listeDebit))
	 (cons (car listeDebit) barre)
	 debitRestant
       )
      )
      (T
       (mettreEnBarre
	 (cdr listeDebit)
	 lgRestante
	 barre
	 (cons (car listeDebit) debitRestant)
       )
      )
    )
  )
  
  (mettreEnBarre (vl-sort (mapcar 'float listeDebit) '>) lgBarre nil nil)
)

 

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

 

 

 

[DenisHen]

Salut PhilPhil.
Personnellement, j'utiliserais les (vlax-ldata,  que tu peut attribuer à chaque entité du dessin ou au dessin même, ce que je suis en train de faire...
Tu peux attribuer n'importe quel valeur, et plusieurs fois, des valeurs à n'importe quelles entités.
En gros, tu as deux champs, un "général" et un plus "ciblé".
Du coup, Tu finis par fouiller la totalité du dessin en cherchant les (vlax-data qui t'intéressent.
Je cherche actuellement à faire ce genre de programme, j'utilise ces (vlax-data depuis des années, et c'est le miracle, mais il y a aussi les dictionnaires, que j'ai tenté d'essayer, mais je n'arrive pas à les maitriser autant.
Bien à toi.
Denis.