Выполнение оптимизации на VB6.0 по раскрою

;Автор Никита Однороб
 
Structure el
  width.l
  k.l
  List ottr.l()
EndStructure
 
Procedure GetEl(List l.l(), Index)
  PushListPosition(l())
  SelectElement(l(), Index)
  Protected res = l()
  PopListPosition(l())
  ProcedureReturn res
EndProcedure
 
Procedure SetEl(List l.l(), Index, Value)
  PushListPosition(l())
  SelectElement(l(), Index)
  l() = Value
  PopListPosition(l())
EndProcedure
 
Global NewList ottr.l()
Global v = 1
Global n = 0
 
Global Dim dp.el(9999)
Global k = 0
 
Procedure Test()
  For i = 0 To k-1
    If dp(i)\width = v
      ProcedureReturn 1
    EndIf
  Next
EndProcedure
 
Procedure Find(w)
  For i = 0 To k-1
    If dp(i)\width = w
      ProcedureReturn 1
    EndIf
  Next
  ProcedureReturn 0
EndProcedure
 
Procedure Count()
  ;Считаем
  Protected b = 0
  For j = 0 To n-1
    b = k - 1
    For i = 0 To b
      If GetEl(ottr(), j) + dp(i)\width <= v And Find(GetEl(ottr(), j) + dp(i)\width) = 0
        dp(k)\width = GetEl(ottr(), j) + dp(i)\width
        ForEach dp(i)\ottr()
          AddElement(dp(k)\ottr())
          dp(k)\ottr() = dp(i)\ottr()
        Next
        AddElement(dp(k)\ottr())
        dp(k)\ottr() = j
        k + 1
      EndIf
    Next
    
    If Find(GetEl(ottr(), j)) = 0
      dp(k)\width = GetEl(ottr(), j)
      
      AddElement(dp(k)\ottr())
      dp(k)\ottr() = j
      
      k + 1
    EndIf
    
    If Test() = 1 : Break : EndIf
  Next
EndProcedure
 
Procedure Clear()
  k = 0
  FreeArray(dp())
  Global Dim dp.el(9999)
  
  ForEach ottr()
    If ottr() = 0
      DeleteElement(ottr())
    EndIf
  Next
  
  n = ListSize(ottr())
EndProcedure
 
Procedure Start()
  Protected text$ = ""
  Protected t2$ = ""
  Protected i, p, cc = 0, s = 0, ss = 0, res.d, ost
  v = Val(GetGadgetText(1))
  
  For i = 0 To CountGadgetItems(3)-1
    For p = 1 To Val(GetGadgetItemText(3, i, 0))
      AddElement(ottr())
      ottr() = Val(GetGadgetItemText(3, i, 1))
      n + 1
    Next
  Next
  
  While n > 0
    s = 0
    Debug ListSize(ottr())
    Count()
    SortStructuredArray(dp(), #PB_Sort_Descending, OffsetOf(el\width), #PB_Long, 0, k-1)
    ForEach dp(0)\ottr()
      If GetEl(ottr(), dp(0)\ottr()) <> 0
        text$ + Str(GetEl(ottr(), dp(0)\ottr())) + "  "
        s + GetEl(ottr(), dp(0)\ottr())
        ss + GetEl(ottr(), dp(0)\ottr())
      EndIf
      SetEl(ottr(), dp(0)\ottr(), 0)
    Next
    Clear()
    res = (s)/v*100.0
    text$ + "(" + StrD(res, 2) + "%)" + #CRLF$
    cc + 1
  Wend
  
  res = (v*cc - ss)/(v*cc)*100.0
  text$ + #CRLF$ + "Общий остаток - " + Str(v*cc - ss) + " из " + Str(v*cc) + " (" + StrD(res, 2) + "%)"
  
  t2$ = "Потребуется " + Str(cc) + " кусков" + #CRLF$ + #CRLF$
  
  MessageRequester("", t2$ + text$)
  
   If CreateFile(0, "ОтветText.txt")       
    
      WriteStringN(0,  t2$ )  
    
      WriteString(0, text$)  
   
    CloseFile(0)                       
  Else
    MessageRequester("Information","may not create the file!")
  EndIf
 
 
  
  ClearGadgetItems(3)
  SetGadgetText(1, "")
  SetGadgetText(4, "")
  SetGadgetText(5, "")
  ClearList(ottr())
  v = 0
  n = 0
EndProcedure
 
Procedure OpenWnd()
  OpenWindow(0, 5, 5, 260, 410, "Уголки", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  TextGadget(0, 15, 10, 160, 25, "Длина кусков арматуры (см):")
  SpinGadget(1, 175, 5, 70, 24, 1, 10000, #PB_Spin_Numeric)
  
  TextGadget(2, 5, 35, 250, 24, "Требуемые уголки", #PB_Text_Center)
  ListIconGadget(3, 5, 65, 250, 250, "Количество", 125, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
  AddGadgetColumn(3, 1, "Длина", 120)
  
  SpinGadget(4, 5, 320, 120, 24, 1, 100, #PB_Spin_Numeric)
  SpinGadget(5, 130, 320, 120, 24, 1, 1000, #PB_Spin_Numeric)
  
  ButtonGadget(6, 30, 350, 100, 24, "Добавить")
  ButtonGadget(7, 140, 350, 100, 24, "Удалить")
  
  ButtonGadget(8, 80, 380, 100, 24, "Вычислить")
EndProcedure
 
OpenWnd()
 
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      End
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 6
          If GetGadgetText(4) <> "" And GetGadgetText(5) <> "" And Val(GetGadgetText(5)) <= Val(GetGadgetText(1))
            AddGadgetItem(3, -1, GetGadgetText(4) + Chr(10) + GetGadgetText(5))
            SetGadgetText(4, "")
            SetGadgetText(5, "")
          EndIf
        Case 7
          RemoveGadgetItem(3, GetGadgetState(3))
        Case 8
          If GetGadgetText(1) <> "" And CountGadgetItems(3) > 0
            Start()
          EndIf
      EndSelect
  EndSelect
ForEver
; IDE Options = PureBasic 5.30 (Windows - x86)
; CursorPosition = 131
; FirstLine = 117
; Folding = --
; EnableUnicode
; EnableXP
; CompileSourceDirectory

[B]Потребуется 498 кусков[/B]
 
 
185  165  (100.00%)
185  165  (100.00%)
... всего 127 раз
185  165  (100.00%)
 
87  87  87  87  (99.43%)
87  87  87  87  (99.43%)
... всего 131 раз
87  87  87  87  (99.43%)
 
165  26  26  26  26  26  26  26  (99.14%)
165  26  26  26  26  26  26  26  (99.14%)
... всего 131 раз
165  26  26  26  26  26  26  26  (99.14%)
 
87  26  26  26  26  26  26  26  26  26  26  (99.14%) — первый раз
87  26  26  26  26  26  26  26  26  26  26  (99.14%)  — второй раз. Всего 2 раза!
 
143  143  26  26  (96.57%)
143  143  26  26  (96.57%)
... всего 167 раз
143  143  26  26  (96.57%)
 
26  26  26  26  26  26  26  26  26  26  26  26  26  (96.57%)
26  26  26  26  26  26  26  26  26  26  26  26  26  (96.57%)
... всего 19 раз
26  26  26  26  26  26  26  26  26  26  26  26  26  (96.57%)
 
143  (40.86%) — первый раз. Всего один раз!
 
[B]Общий остаток - 2860 из 174300 (1.64%)[/B]

Потребуется 498 кусков
 
 
185  165  (100.00%) 'строки 4-130 или (130 - 3 = 127 раз)
87  87  87  87  (99.43%) 'строки 131-261 или (261 - 130 = 131 раз)
165  26  26  26  26  26  26  26  (99.14%) 'строки 262-312 или (312 - 261 = 51 раз)
87  26  26  26  26  26  26  26  26  26  26  (99.14%) 'строки 313-314 или (314 - 312 = 2 раза)
143  143  26  26  (96.57%) 'строки 315-481 или (481 - 314 = 167 раз)
26  26  26  26  26  26  26  26  26  26  26  26  26  (96.57%) 'строки 382-500 или (500 - 481 = 19 раз)
143  (40.86%) 'строка 501 или (501 - 500 = 1 раз)
 
Общий остаток - 2860 из 174300 (1.64%) 'по тексту это последняя строка 503