Friday, October 16, 2020

My only use of PureBasic

It was 2015 and I was taking a course on Discrete Event Simulation for my master's degree in computer modeling and simulation. We had a group project and needed to simulate the process flow of an imaginary factory. I though I would implement some of the calculations in PureBASIC  to help me get a taste of the language. It was not too bad. I quickly figured out how to make the procedures, array manipulation, and loops I needed. The final script ended up very useful for the project and I shared it with the rest of the class. I think it's fairly readable even for people who don't know PureBASIC. Here is the little script I wrote long ago.

 Procedure.f sum(Array dataInput(1))
  total.f = 0.0
  For i=0 To ArraySize(dataInput())
    total = total + dataInput(i)
  Next
  ProcedureReturn total
EndProcedure

Procedure.f min(Array dataInput(1))
  min.f = dataInput(0)
  For i=0 To ArraySize(dataInput())
    If dataInput(i) < min
      min = dataInput(i)
    EndIf
  Next
  ProcedureReturn min
EndProcedure

Procedure Main()
  ; myDEBUG = 1 to see more console output
  myDEBUG.l = 0
  ; User interface setup
  OpenConsole()
  EnableGraphicalConsole(1)
  ConsoleLocate(0,0)
  PrintN("makespan calculator started...")
 
  ; Load tool timing data from csv file
  FileName$ = OpenFileRequester("Choose a CSV File", "", "*.csv|*.csv", 0)
 
  If OpenFile(0, FileName$)
    While Not Eof(0)
      line$ = ReadString(0)
      
    Wend
    CloseFile(0)
  EndIf
 
  ;; Calculate makespan for flow shop
  Dim dataTable.f(3,3)
 
  dataTable(0,0) = 2.0
  dataTable(0,1) = 3.5
  dataTable(0,2) = 1.5
  dataTable(0,3) = 2.0
  dataTable(1,0) = 4.5
  dataTable(1,1) = 3.0
  dataTable(1,2) = 2.5
  dataTable(1,3) = 1.0
  dataTable(2,0) = 1.5
  dataTable(2,1) = 1.5
  dataTable(2,2) = 5.0
  dataTable(2,3) = 0.5
  dataTable(3,0) = 4.0
  dataTable(3,1) = 1.0
  dataTable(3,2) = 2.5
  dataTable(3,3) = 0.5
 
  ;; Construct a Gantt chart to show how the makespan is calculated.
  ;; For Example 4.3 from the textbook the desired job sequence is {2,4,1,3}
  NewList jobSeq.l()
  AddElement(jobSeq())
  jobSeq() = 2
  AddElement(jobSeq())
  jobSeq() = 4
  AddElement(jobSeq())
  jobSeq() = 1
  AddElement(jobSeq())
  jobSeq() = 3
 
  PrintN("jobSeq Contents:")
  ForEach jobSeq()
    Print(Str(jobSeq()) + " ")
  Next
  PrintN("")
 
  ResetList(jobSeq())
 
  ;; Now we calculate the makespan using the jobSeq and data from dataTable
  t.f = 0.0
  dt.f = 0.1
  jobsDone.l = 0
  Dim toolTimes.f(3)
  Dim jobAtTool.l(3)
  lastTool.l = 3
 
  ; Initialize arrays
  For i = 0 To ArraySize(toolTimes())
    toolTimes(i) = 0.0
    jobAtTool(i) = 0
  Next
 
  ; Start running the simulation
  While jobsDone < ListSize(jobSeq())
    For i = 0 To ArraySize(toolTimes())
      If i = 0
        ; The first tool will load the next job if idle, and if jobs are available
        ; Make sure the first tool is idle and empty of jobs
        If toolTimes(i) <= 0 And jobAtTool(i) = 0 And NextElement(jobSeq()) <> 0
          jobAtTool(i) = jobSeq()
          toolTimes(i) = dataTable(jobAtTool(i)-1, i)
        EndIf
        
        ; Move time step if there is a job on tool
        If toolTimes(i) > 0
          toolTimes(i) = toolTimes(i) - dt
        Else
          ; do nothing
        EndIf
        
      ElseIf i = ArraySize(toolTimes())
        ; We are in the last tool. Check to see if it has a job and if it is done processing, then we move the job
        ; out and add to jobsDone tally
        If toolTimes(i) <= 0 And jobAtTool(i) <> 0
          jobsDone = jobsDone + 1
          jobAtTool(i) = 0
        EndIf
        
        ; Move previous tools job into current tool if available
        If toolTimes(i-1) <= 0 And jobAtTool(i-1) <> 0 And jobAtTool(i) = 0
          jobAtTool(i) = jobAtTool(i-1)
          jobAtTool(i-1) = 0
          toolTimes(i) = dataTable(jobAtTool(i)-1, i)
        EndIf
      
        ; If there is a job in current tool and there is processing time then move time step forward.
        If toolTimes(i) > 0
          toolTimes(i) = toolTimes(i) - dt
        Else
          ; do nothing
        EndIf
        
      Else
        ; We are after the first tool but before the last
        ; Check if tool is empty but with a job. Then it is done with job.
        ; Check if next tool is empty, if so then move job to next tool.
        ; Check if previous tool is empty. If so then increment time and move on.
        ; Check if previous tool is empty but with a job, then if current tool is empty move job.
        
        ; Move job to next tool if next tool is empty and current tool is done processing
        If jobAtTool(i) <> 0 And jobAtTool(i+1) = 0 And toolTimes(i) <= 0
          jobAtTool(i+1) = jobAtTool(i)
          toolTimes(i+1) = dataTable(jobAtTool(i+1)-1, i)
          jobAtTool(i) = 0
        EndIf
        
        ; Move previous tool's job into current tool if available
        If toolTimes(i-1) <= 0 And jobAtTool(i-1) <> 0 And jobAtTool(i) = 0
          jobAtTool(i) = jobAtTool(i-1)
          toolTimes(i) = dataTable(jobAtTool(i)-1, i)
          jobAtTool(i-1) = 0
        EndIf
        
        ; Increment t and decrement tool's processing time if busy with a job.
        If toolTimes(i) > 0
          toolTimes(i) = toolTimes(i) - dt
        Else
          ; Do nothing
        EndIf
      EndIf
    Next
    
    t = t + dt
    If myDEBUG = 1
      PrintN("t: " + t)
      PrintN("Job Status:")
      For i = 0 To ArraySize(jobAtTool())
        Print(Str(jobAtTool(i)) + " ")
      Next
      PrintN("")
      
      PrintN("jobsDone: " + Str(jobsDone) + " out of " + Str(ListSize(jobSeq())) )
      
      ;PrintN("Tool Times")
      ;For i = 0 To ArraySize(toolTimes())
      ;  Print(Str(toolTimes(i)) + " ")
      ;Next
      ;PrintN("")
      
      ;Delay(500)
    EndIf
    
  Wend
 
  PrintN("makespan: " + t)
  PrintN("Enter key to quit")
  done$ = Input()
  CloseConsole()
  EndProcedure
 
  Main()
 
; IDE Options = PureBasic 5.42 LTS (Windows - x64)
; ExecutableFormat = Console
; CursorPosition = 30
; FirstLine = 15
; Folding = -
; EnableUnicode
; EnableXP

 

No comments:

Post a Comment