Newsgroup: it.comp.lang.visual-basic
Titolo: [OT] Sfridi

Le verghe di ferro sono generalmente lunghe 6 metri (6000 mm.).
Il mio problema è quello, dovendo fare un certo numero di tagli di lunghezze
diverse, di calcolare come fare i tagli per utilizzare al meglio le verghe.
I "vecchi" operai dicono di partire sempre dalla lunghezze maggiori.
E' un principio buono ma insufficiente
Faccio un esempio banale per chiarire:
- ho 2 verghe di mm.6000
- devo tagliare 4 pezzi lunghi 1600 e 4 pezzi lunghi 1395
Se partissi a tagliare, con la prima verga, 3 pezzi lunghi 1600 mi
rimarrebbe
uno sfrido inutilizzabile di 1200 e con la rimanente verga di 6000 non
riuscirei
a completare i pezzi.
In questo esempio è facile capire che conviene tagliare, per ogni verga, 2
pezzi
lunghi 1600 e due pezzi lunghi 1395.
Riuscirei a completare il lavoro rimanendo solo 2 sfridi di 10 mm.
Il problema si complica se aumenta il numero delle misure (poniamo come
massimo 20) ed il numero di pezzi per ogni misura.
Da un po' sto cercando di risolvere il problema senza riuscire a capire che
logica devo applicare.
Tanto per complicare le cose devo aggiungere che (qualora la "resa" sia di
poco inferiore) e meglio non cambiare misura finchè tutti i pezzi della
misura medesima non sono completati (l'operatore alla sega impiega tempo
quando deve cambiare misura).
Attendo i Vostri eventuali suggerimenti.
Saluti a tutti.
Sauro

Devi usare un algoritmo di ricerca operativa per ottimizzare il tutto.
Non è un algoritmo VB, ma un vero e proprio studio del problema e relativa
progettazione delle formule adatte a risolvere il problema.
Ti consiglio di guardare qui:
http://www.dep.polimi.it/people/Fumero.Francesca/Didat/index.html
bye
-- 
Esistono 10 tipi di persone: chi conosce il binario e chi no.
www.nicolaottomano.it

 
http://www.dep.polimi.it/people/Fumero.Francesca/Didat/index.html
Ho scaricato un po' di files .PDF
Non riesco ad aprirli e non ricordo più che programma microsoft occorre per
farlo.
Grazie.
Ciao, Sauro

 occorre per farlo.
Adobe acrobat reader :-)
Comunque molti esempi puoi trovarli in "Materiale".


 sega impiega tempo quando deve cambiare misura).
Credo che si possa, perň si cambia la barra da tagliare...
Vedi quanto segue, pronto per il tuo caso, vedi con attenzione i commenti:
'Metti un listbox (abbastanza largo, con nome List1) sul form
Private Sub Form_Load()
'       Barre disponibili (bd)
    ReDim bd(1 To 2, 1 To 2)    '2 barre disponibili (dimensione e residuo)
    bd(1, 1) = 6000
    bd(2, 1) = 6000
'       Assegna al residuo l'intera dimensione
    For n = LBound(bd) To UBound(bd)
        bd(n, 2) = bd(n, 1)
    Next n
'       Barre da tagliare (bt)
    ReDim bt(1 To 8, 1 To 2)    '8 barre da tagliare (dimensione e
"fatta"=1/0)
    bt(1, 1) = 1600
    bt(2, 1) = 1600
    bt(3, 1) = 1600
    bt(4, 1) = 1600
    bt(5, 1) = 1395
    bt(6, 1) = 1395
    bt(7, 1) = 1395
    bt(8, 1) = 1395
'       Assegna al "fatta" 0=No
    For n = LBound(bt) To UBound(bt)
        bt(n, 2) = 0
    Next n
    finito = 0
    List1.Clear
    Do
'           Cerco la barra non fatta piu' lunga, se c'e'
        ltmax = 0
        ntmax = 0
        For n = LBound(bt) To UBound(bt)
            If bt(n, 2) = 0 Then
'                   Barra non fatta
                If bt(n, 1) > ltmax Then
                    ltmax = bt(n, 1)
                    ntmax = n
                End If
            End If
        Next n
        If ntmax = 0 Then
'               Ho tagliato tutte le barre
            Call MsgBox("Tutto OK. Fine procedura.", vbOKOnly)
            finito = 1
            Exit Do
        End If
'           Cerco fra le barre disponibili quella con maggior residuo
'           uguale o maggiore della barra da tagliare piu' lunga, se c'e'
        ldmax = 0
        ndmax = 0
        res_max = 0
        For n = LBound(bd) To UBound(bd)
            If bd(n, 2) >= ltmax Then
'                   Residuo disponibile per per la lunghezza ltmax
                If bd(n, 2) > res_max Then
                    res_max = bd(n, 2)
                    ldmax = bd(n, 1)
                    ndmax = n
                End If
            End If
        Next n
        If ndmax = 0 Then
            messaggio = "*** IMPOSSIBILE tagliare la barra num." & ntmax & "
da " & ltmax & " ***"
            List1.AddItem messaggio
            Call MsgBox(messaggio, vbExclamation)
            Exit Do
        End If
'           Taglio la barra (da tagliare) ntmax, con lunghezza ltmax
'           usando la barra disponibile ndmax
        List1.AddItem "Taglio barra num." & ntmax & " da " & ltmax & "
usando barra num." & ndmax & " da " & bd(ndmax, 2) & " (residuo=" &
(bd(ndmax, 2) - ltmax) & ")"
        bt(ntmax, 2) = 1    'Fatta
'           Riduco il residuo della barra disponibile ndmax per la lunghezza
di taglio ltmax
        bd(ndmax, 2) = bd(ndmax, 2) - ltmax
    Loop
    List1.AddItem ""
    List1.AddItem "Procedura " & IIf(finito, "", " NON ") & "conclusa."
    List1.AddItem ""
'       Espone i resti (sfridi, salvo riutilizzo) per barra
    List1.AddItem "Riepilogo residui/sfridi:"
    For n = LBound(bd) To UBound(bd)
        List1.AddItem "Barra num." & n & " residuo=" & bd(n, 2)
    Next n
End Sub

Io resto dell'opinione di applicare la Ricerca Operativa ad un problema di
Programmazione Lineare come questo.
E' metodica e non ti puoi sbagliare se imposti tutte le variabili in modo
corretto.


 modo corretto.
Non discuto. Come dicevo, non ho approfondito.
Fatto sta che quel codice risolve l'esempio indicato e rispetta le regole
dei "vecchi".
Non me la sento, ovviamente, di dire "è il più corretto", però, ragionando,
se taglio sempre alla dimensione maggiore usando sempre la barra con
lunghezza maggiore, difficile che si possa far di meglio...

 meglio...
Anche perchè così mi garantisco il residuo maggiore, pronto per accogliere
la dimensione da tagliare maggiore prossima, ovviamente se non superiore al
maggior residuo (comunque il controllo è presente)...
In termini di velocità non discuto, la ricerca del maggiore (lunghezza di
taglio e residuo disponibile) andrebbe ottimizzata (magari con ordinamenti
particolari e/o memorizzando la "storia" precedente per andare a "botta
sicura", almeno come punto di partenza e/o fine), certo, ma, nel caso
specifico, le barre non saranno 8 miliardi... ;-)

 miliardi... ;-)
Versione (parzialmente) ottimizzata per la ricerca della barra da tagliare
più lunga:
'Metti un listbox (abbastanza largo, con nome List1) sul form
Private Sub Form_Load()
'       Barre disponibili (bd)
    ReDim bd(1 To 2, 1 To 2)        '2 barre disponibili (dimensione e
residuo)
    bd(1, 1) = 6000
    bd(2, 1) = 6000
    'bd_ordinate_decrescenti = 1    'Non serve, perche' contano i residui,
imprevedibili e quindi non ordinabili
'       Assegna al residuo l'intera dimensione
    For n = LBound(bd) To UBound(bd)
        bd(n, 2) = bd(n, 1)
    Next n
'       Barre da tagliare (bt)
    ReDim bt(1 To 8, 1 To 2)        '8 barre da tagliare (dimensione e
"fatta"=1/0)
    bt(1, 1) = 1600
    bt(2, 1) = 1600
    bt(3, 1) = 1600
    bt(4, 1) = 1600
    bt(5, 1) = 1395
    bt(6, 1) = 1395
    bt(7, 1) = 1395
    bt(8, 1) = 1395
    bt_ordinate_decrescenti = 1     'Se <>0 indica che le dimensioni delle
barre da tagliare
'                                   'sono in ordine decrescente,
ottimizzando la ricerca della
'                                   'barra da tagliare piu' lunga
'       Assegna al "fatta" 0=No
    For n = LBound(bt) To UBound(bt)
        bt(n, 2) = 0
    Next n
    finito = 0
    List1.Clear
    Do
'           Cerco la barra non fatta piu' lunga, se c'e'
        ltmax = 0
        ntmax = 0
        For n = LBound(bt) To UBound(bt)
            If bt(n, 2) = 0 Then
'                   Barra non fatta
                If bt(n, 1) > ltmax Then
                    ltmax = bt(n, 1)
                    ntmax = n
                Else
                    If bt_ordinate_decrescenti Then
'                           Le dimensioni delle barre da tagliare sono in
ordine decrescente
'                           Questa barra e' di dimensioni inferiori o uguali
alla piu' lunga sinora rilevata
'                           Inutile procedere, essendo ordinate in modo
decrescente
'                           le restanti saranno tutte di dimensioni
inferiori o uguali
                        Exit For
                    End If


[Lupo = 
circa_LupoOrm...@libero.it
 in
c3hi8h$28rl5h$
1...@ID-174464.news.uni-berlin.de
] ha scritto:
... una cosa che non ottimizza ... qualcosa.
Una bambolina (e il codice) a chi indovina cosa.
Se non ve ne importa nulla, tzè, me lo tengo. :-P

 
www.nicolaottomano.it
Ok, l'ho caricato e letto i files.
Non ho trovato esempi adeguati a risolvere il mio problema.
O, forse, non sono stato abbastanza perspicace.
Ciao, Sauro

 O, forse, non sono stato abbastanza perspicace.
Non sono esempi mirati, ma solo esempi guida.
Dovreti impostare tu il problema e risolverlo matematicamente.
La risoluzione con VB è semplice, se vuoi ti passo un sito dove scaricare
progetti di risoluzione di problemi di programmazione lineare.
Per quanto riguarda le variabili del problema è a discrezione dell'operatore
(tu) sceglierle.
Mi rendo conto che se non hai mai studiato Ricerca Operativa sicuramente
incontrerai grosse difficoltà.
Buon Lavoro.


Il problema mi ha intrigato.
Ho quindi tentato di risolverlo in maniera esaustiva (pur conscio a priori
che un problema tipicamente combinatorio come questo, quando affrontato in
maniera non euristica ma esaustiva, tende ad esaurire tutte le risorse di
qualsiasi macchina con numeri di pezzi da considerare niente affatto
enormi).
Il codice che ti posto non è finito, nel senso che quando ho capito di avere
praticamente risolto il problema (ricerca delle soluzioni ottime e non
soltanto di buone soluzioni, al prezzo del limite citato prima sulla
voracità di risorse) mi è anche passato l'interesse.
Se te lo studi ben bene penso che riesci a farlo funzionare a tuo vantaggio
:
mancano alcune ottimizzazioni, specialmente quella che dovrebbe sfrondare
l'array di dimensioni dei pezzi scorporando dal computo quelli che per
coincidenza dovessero essere lunghi esattamente come la barra standard (con
risparmio di risorse computazionali).
Anche la gestione degli errori è inesistente, ma mi aspetterei dei gran Out
Of Memory con numeri di barre da ottimizzare non elevati.
Cmq vedi tu, se riesci ad adattare il codice bene, se no .... pazienza.
ah, alcune righe sono state mandate a capo automatico dal fottutissimo O.E.
.... ricollegale a mano se ti interessa
Ciao
Soviet-Mario
Attribute VB_Name = "Euristica_Barre_Ferro"
Option Explicit
Public Declare Sub CopyMemoryToArrFromArr Lib "KERNEL32.DLL" Alias
"RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Declare Sub CopyMemory Lib "KERNEL32.DLL" Alias "RtlMoveMemory"
(lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Function Fattoriale(ByVal Enne As Long) As Long
Dim J As Long, NumPermutazioni As Long
NumPermutazioni = 1
For J = 2 To Enne
    NumPermutazioni = NumPermutazioni * J
Next J
Fattoriale = NumPermutazioni
End Function
Sub ArrayGrowAndInsert(OldArray() As Byte, NewArray() As Byte, ByVal
ValueToInsert As Byte, ByVal Posizione As Long)
If (LBound(OldArray()) < 1) Or (LBound(OldArray()) > UBound(OldArray()))
Then
    Err.Raise 100001, "ArrayGrowAndInsert", "argument OldArray must be
1-based, not 0-based (or less) !"
End If
ReDim NewArray(1 To 1 + UBound(OldArray())) As Byte
If (Posizione > 1) Then
    Call CopyMemoryToArrFromArr(NewArray(1), OldArray(1), (1 * (Posizione -
1)))
End If
NewArray(Posizione) = ValueToInsert
If (Posizione <= UBound(OldArray())) Then
    Call CopyMemoryToArrFromArr(NewArray(Posizione + 1),
OldArray(Posizione), (1 * (UBound(OldArray()) - Posizione + 1)))
End If
End Sub
Sub GeneraPermutazioni(ByVal NumDifferentElems As Byte, NewPermutaz() As
Byte)
Dim Index As Long
Dim NumPermutazioni As Long
Dim NumNewArrays As Long
Dim OldPermIdx As Long
Dim PosizDaScrivere As Long
Dim NumNewArraysPos As Long
NumPermutazioni = Fattoriale(NumDifferentElems)
ReDim OldPermutaz(1 To 1, 1 To 1) As Byte
OldPermutaz(1, 1) = 1
For Index = 2 To NumDifferentElems
    NumNewArraysPos = 1
    NumNewArrays = Fattoriale(Index)
    ReDim NewPermutaz(1 To Index, 1 To NumNewArrays) As Byte
    ReDim TmpOld(1 To UBound(OldPermutaz(), 1)) As Byte
    ReDim TmpNew(1 To 1 + UBound(OldPermutaz(), 1)) As Byte
    For OldPermIdx = 1 To UBound(OldPermutaz(), 2)
        For PosizDaScrivere = 1 To UBound(OldPermutaz(), 1) + 1
            Call CopyMemoryToArrFromArr(TmpOld(1), OldPermutaz(1,
OldPermIdx), ((Index - 1) * 1))
            '''Call DebugArrayToClipBoard(TmpOld())
            Call ArrayGrowAndInsert(TmpOld(), TmpNew(), Index,
PosizDaScrivere)
            '''Call DebugArrayToClipBoard(TmpOld())
            '''Call DebugArrayToClipBoard(TmpNew())
            Call CopyMemoryToArrFromArr(NewPermutaz(1, NumNewArraysPos),
TmpNew(1), (Index * 1))
            '''Call DebugArrayToClipBoard(TmpNew())
            NumNewArraysPos = NumNewArraysPos + 1
        Next PosizDaScrivere
    Next OldPermIdx
    '''Call DebugMatrixToClipBoard(OldPermutaz())
    '''Call DebugMatrixToClipBoard(NewPermutaz())
    OldPermutaz() = NewPermutaz()
Next Index
Erase OldPermutaz()
Erase TmpOld()
Erase TmpNew()
End Sub
Sub DebugMatrixToClipBoard(MatriceBidimens() As Byte)
Dim Permutaz As Long, Digit As Long
Dim Tmp As String, Ret As String
Ret = ""
For Permutaz = 1 To UBound(MatriceBidimens(), 2)
    Tmp = Space$(4 * UBound(MatriceBidimens(), 1))
    For Digit = 1 To UBound(MatriceBidimens(), 1)
        Mid$(Tmp, (1 + 4 * (Digit - 1)), 4) =
Trim$(Str(MatriceBidimens(Digit, Permutaz)))
    Next Digit
    Ret = Ret & Tmp & vbCrLf
Next Permutaz
Clipboard.SetText Ret, vbCFText
Debug.Print Ret
End Sub
Sub DebugArrayToClipBoard(ArrayUnidimens() As Byte)
Dim Digit As Long
Dim Ret As String
Ret = Space$(4 * UBound(ArrayUnidimens()))
For Digit = 1 To UBound(ArrayUnidimens())
    Mid$(Ret, (1 + 4 * (Digit - 1)), 4) = Trim$(Str(ArrayUnidimens(Digit)))
Next Digit
Clipboard.SetText Ret, vbCFText
Debug.Print Ret
End Sub
Sub CompattaIndiciDiPezziUguali(MatricePermutazioni() As Byte, RodsSizes()
As Long)
Dim J As Long
Dim Q As Long
For J = LBound(RodsSizes()) To UBound(RodsSizes()) - 1
    For Q = J + 1 To UBound(RodsSizes())
        If (RodsSizes() = RodsSizes()) Then
            ''' ricodifica degli indici nella matrice bidimensionale
            Call MatrixReEncodeIndexesWithEqualSizes(MatricePermutazioni(),
Q, J)
            Call DebugMatrixToClipBoard(MatricePermutazioni())
        End If
    Next Q
Next J
Call DebugMatrixToClipBoard(MatricePermutazioni())
End Sub
Sub MatrixReEncodeIndexesWithEqualSizes(MatricePermutazioni() As Byte, ByVal
LevaIndex As Byte, MettiIndex As Byte)
Dim Permutaz As Long
Dim Digit As Long
For Permutaz = 1 To UBound(MatricePermutazioni(), 2)
    For Digit = 1 To UBound(MatricePermutazioni(), 1)
        If (MatricePermutazioni(Digit, Permutaz) = LevaIndex) Then
            MatricePermutazioni(Digit, Permutaz) = MettiIndex
        End If
    Next Digit
Next Permutaz
End Sub
Function ControllaBarreTroppoLunghe(RodsSizes() As Long, ByVal
StandardRodSize As Long, ByRef Errore As String) As Boolean
On Error GoTo Err_ControllaBarreTroppoLunghe
ControllaBarreTroppoLunghe = True
Errore = ""
Dim J As Long
For J = LBound(RodsSizes()) To UBound(RodsSizes())
    If (RodsSizes(J) > StandardRodSize) Then
        ControllaBarreTroppoLunghe = False
        Errore = Errore & " " & Str(J)
    End If
Next J
If Not (Errore = "") Then
    Errore = "Barre troppo lunghe : " & Errore
End If
Esc_ControllaBarreTroppoLunghe:
On Error GoTo 0
Exit Function
Err_ControllaBarreTroppoLunghe:
Errore = "Euristica_Barre_Ferro >> ControllaBarreTroppoLunghe : " &
Err.Source & Err.Description
ControllaBarreTroppoLunghe = False
Resume Esc_ControllaBarreTroppoLunghe
End Function
Sub ValutaSfridi(MatricePermutazioni() As Byte, RodsSizes() As Long, ByVal
StandardRodSize As Long, Sfridi() As Long)
Dim Permutaz As Long
Dim PezzoIdx As Long
Dim TotPezzi As Long
Dim CurrParzSize As Long
Dim OldCurrParzSize As Long
If (ControllaBarreTroppoLunghe(RodsSizes(), StandardRodSize, Errore) =
False) Then
    MsgBox Errore, , "Overflow barra standard"
    Err.Raise 100002, "ValutaSfridi", "Almeno una barra supera la dimensione
massima commerciale ! " & vbCrLf & Errore
End If
Call CompattaIndiciDiPezziUguali(MatricePermutazioni(), RodsSizes())
ReDim Sfridi(1 To UBound(MatricePermutazioni(), 2)) As Long
For Permutaz = 1 To UBound(MatricePermutazioni(), 2)
    Sfridi(Permutaz) = 0
    CurrParzSize = 0
    TotPezzi = 1
    For PezzoIdx = 1 To UBound(MatricePermutazioni(), 1)
        OldCurrParzSize = CurrParzSize
        CurrParzSize = CurrParzSize +
RodsSizes(MatricePermutazioni(PezzoIdx, Permutaz))
        If (CurrParzSize > StandardRodSize) Then
            TotPezzi = TotPezzi + 1
            Sfridi(Permutaz) = Sfridi(Permutaz) + StandardRodSize -
OldCurrParzSize
            CurrParzSize = CurrParzSize - OldCurrParzSize
        End If
    Next PezzoIdx
Next Permutaz
End Sub
''' a questo punto occorre 1) cercare gli sfridi minori
''' dell'array  Sfridi(Permutaz)

Grazie.
Lo proverň e ti informerň sui risultati.
Ciao, Sauro

 Buon Lavoro.
Da semplice ragioniere non solo non ho studiato "Ricerca Operativa" ma non
so neanche cosa sia.    ;-)
Un mio amico ingegnere (non informatico) mi ha detto che per questo problema
bisogna utilizzare la matematica euristica.
Per il momento proverņ la soluzione proposta da Soviet-Mario.
Grazie Nicola.
Ciao, Sauro

Soviet_Mario wrote in message:

Ho copiato il tutto in un modulo ed ho sistemato le righe interrotte.
Ho letto il tutto con attenzione ma ho capito (forse) soltanto che le sub
vanno chiamate con questa sequenza:
1°) GeneraPermutazioni
2°) ValutaSfridi
... e che un certo numero di arrays vanno dimensionati a livello pubblico.
Capisco che, una volta risolto il problema, tu abbia perso interesse
nell'argomento.
Ti prego comunque, se non è per te di troppo disturbo, di farmi un breve
esempio per un caso come questo (lunghezze e quantità a caso):
24 pezzi lunghi mm. 1400
24 pezzi lunghi mm. 1800
48 pezzi lunghi mm. 620
verghe lunghe 6000.
Mi basterebbe solo questo:
1) dimensionamento degli array pubblici
2) assegnazione dei valori (come sopra)
3) richiamo della sub GeneraPermutazioni
Per il resto (ValutaSfridi, ecc.) penso di poter continuare da solo.
Grazie.
Ciao, Sauro

 ma non so neanche cosa sia.    ;-)
Ha un nome assurdo, ma è semplicemente un ragionamento logico.
In sostanza si tratta di ridurre il problema a semplici disequazioni.
Credo che il tuo problema (peraltro molto semplice) possa essere risolto con
5-6 disequazioni in meno di mezzora...


 5-6 disequazioni in meno di mezzora...
Prima "Ricerca operativa", poi matematica euristica, adesso disequazione.
Quante cose che non so!  :-)
Ciao, Sauro

 Quante cose che non so!  :-)
beh sostanzialmente la ricerca operativa traduce il tutto in equazioni e
disequazioni. :-)
Bye
