;;
globals [gv-original-matrix gv-reduced-matrix gv-scribe gv-headers  ]
breed [handlers a-handler]
breed [records a-record]
breed [entities a-part]
patches-own [dm-zone]
turtles-own [dm-cohort dm-arrival dm-departure]
handlers-own [dm-next-event dm-acceptors lambda-event]
records-own [dm-site dm-bulldozer dm-cost dm-strikethrough? ]
entities-own [dm-value ]
;;
to setup
  clear-all
  carefully [
    set-default-shape handlers "flag"
    set-default-shape records "circle"
    set-default-shape entities "box"
    ask patches [set dm-zone ""]
    ask patches with [11 < pycor ]  [set pcolor pink set dm-zone "FEL"]
    ask patches with [pxcor < -11 ] [set pcolor lime set dm-zone "arrival"]
    ask patches with [(pxcor < -11) and (0 < pycor)] [set pcolor cyan set dm-zone "departure"]
    foreach remove-duplicates [dm-zone] of patches [
      ask one-of patches with [? = dm-zone] [set plabel dm-zone]
    ]
    mt-data-entry
    mt-label-cost-matrix "original"
    eh-raise-event "initializer" 0 gv-scribe task [pm-init]
    output-show (word " press go to start the hungarian method to solve the assignment problem with this cost matrix ...")
    show (word  " ---------------------------------------  Hungarian method   STARTS  ------------------------   dimension of the cost matrix: " bu-dim)
  ] [eh-catch 0 "observer" "setup" error-message]
  reset-ticks
end
;;
to go
  carefully [
    if any? (handlers-on patches with ["arrival" = dm-zone]) with ["exch" = dm-cohort]   [error (word " there are orders over there that prevent system to continue running!")  ]
    ask (handlers-on patches with ["arrival" = dm-zone] )  with [member? "event" dm-cohort ] [
      move-to one-of patches with ["departure" = dm-zone]
      set color violet
      set dm-departure ticks
      if  ticks < dm-next-event  [error (word self label " this event is scheduled in the future and is not expected here! " patch-here)]
    ]
    let lv-events-to-dispatch  (handlers-on patches with ["FEL" = dm-zone] )  with [(member? "event" dm-cohort) and (dm-next-event <= ticks)] 
    ifelse any? lv-events-to-dispatch [
      ask lv-events-to-dispatch [
        move-to one-of patches with ["arrival" = dm-zone]
        set color green
        set dm-arrival ticks
        ask dm-acceptors [run [lambda-event] of myself]
        set lambda-event task [error (word self " this event has already been dispatched!")]
      ]
    ] [error (word " system malfunction: future event list is empty!") ] 
    tick-advance (rpt-next-event - ticks)
    clear-output
    output-show (word rpt-cron " timer:" precision timer 1 " space, count turtles:"  count turtles  ) 
  ] [eh-catch ticks "observer" "go" error-message stop]
end
;;
to eh-raise-event [#tag #when #acceptor #lambda]
  if not (is-turtle-set? #acceptor or is-turtle? #acceptor)  [error (word #acceptor " is expected to be a turtle set ready to accept this event! " #tag " due at " #when)] 
  if not (is-command-task? #lambda) [error (word #lambda " is expected to be a command task!")]
  ask one-of patches with [("FEL" = dm-zone) and (rpt-neighbors-on? "FEL")]  [
    sprout-handlers 1 [
      set dm-cohort (word "event-" #tag)
      set dm-next-event #when
      set dm-acceptors #acceptor
      set lambda-event #lambda
      set label (word #tag "@" #when)
      set color blue
      if bu-verify-mode? [show (word dm-cohort " DEBUG! event due at " dm-next-event " has been raised in  " [dm-zone] of patch-here) ]
    ]
  ]
end
;;
to eh-catch [#when #who #where #what]
  show (word  " ---------------------------------------    S Y S T E M         I N T E R R U P T I O N   ----------------------------  @ " #where  "; raised by " #who)
  show (word  " cron:" #when  " exception: " #what)
  let lv-lane patches with ["arrival" = dm-zone] 
  let lv-candidates (handlers-on lv-lane) with ["exch" = dm-zone]
  if not any? lv-candidates [
    ask one-of lv-lane [
      sprout-handlers 1 [
        set dm-cohort "exch"
        set dm-arrival #when
        set color violet
        set shape "bug"
        set size 3
        set label (word " cron:" #when " exception:" #what  "; raised at " #where  "; by " #who )
        if (member? "HALT!" #what) [set dm-cohort "HALT!" set shape "flag" set color red set label dm-cohort set size 2]
        watch-me
      ]
    ]
  ]
end
;;
to pm-finalize [#end-condition]
  carefully [
    if not (is-a-record? self and "scribe" = dm-cohort)  [error (word self label " was expected to be the scribe agent to finalize calculus!")]
    set label (word "min-cost " precision dm-cost 1)
    set color green
    if bu-verify-mode? [show (word rpt-cron rpt-who self " DEBUG! reaches a final state ... " #end-condition " total cost:" dm-cost )]
    if any? gv-headers with [false = dm-strikethrough?] [error (word self rpt-who self  " expected reduced matrix completely stroken!")]
    eh-raise-event "HALT!"        (1 + ticks) gv-scribe task [error (word "HALT! order received at " ticks)]
  ] [eh-catch ticks self "finalize" error-message ]
end
;;
to pm-init
  carefully [
    if not (is-a-record? self and "scribe" = dm-cohort)  [error (word self label " was expected to be the scribe agent to initialize experiment!")]
    reset-timer 
    if bu-verify-mode? [show (word rpt-cron dm-cohort label " DEBUG!  ... initializes  Turing's task cycle ... ")]
    eh-raise-event "reduce-rows"   (1 + ticks) gv-headers with [0 = dm-site]       task [pm-reduce-line]
    eh-raise-event "reduce-cols"   (2 + ticks) gv-headers with [0 = dm-bulldozer]  task [pm-reduce-line]
    eh-raise-event "strike"        (5 + ticks) gv-scribe                           task [pm-decide-strikethrough]
  ] [eh-catch ticks self "initializer" error-message ] 
end
;;
to pm-select-solution 
  carefully [
    if not (is-a-record? self and "header" = dm-cohort and 0 = dm-bulldozer)  [error (word self dm-cohort " was expected to be the a column header!")]
    let lv-cell one-of ((rpt-my-array "uncovered")  with [0 = dm-cost] )
    if bu-verify-mode? [show (word rpt-cron rpt-who self " DEBUG! now I will pick an uncovered cell " lv-cell " in this column with a null cost.")]
    if (nobody = lv-cell) [error (word self  (rpt-who self) " my line was expected to have at least one cell in the uncovered reduced minor with null cost!")]  
    ask lv-cell [
      let lv-match-original gv-original-matrix with [dm-bulldozer = [dm-bulldozer] of myself and dm-site = [dm-site] of myself]
      if (1 != count lv-match-original)  [error (word lv-match-original " this cell was expected to have a unique associate cell in the original cost matrix!")]
      ask lv-match-original [
        set color green  let lv-cost dm-cost
        ask gv-scribe [ set dm-cost (lv-cost + dm-cost)  set label precision dm-cost 1  set hidden? false set plabel "" ]
        if bu-verify-mode? [show (word rpt-cron rpt-who self " DEBUG! is selected assigment with cost: " lv-cost   ) ]
      ]
      ask rpt-my-headers [set dm-strikethrough? true]
      ask rpt-my-row-col [set dm-strikethrough? true]
    ]
    let lv-next-col rpt-prior 
    ifelse (nobody = lv-next-col) [eh-raise-event "finalize"         (1 + ticks) gv-scribe    task [pm-finalize "normal"]  ]
                                  [
                                    if bu-verify-mode? [show (word rpt-cron rpt-who self " DEBUG! next candidate ... "  lv-next-col rpt-who lv-next-col ) ]
                                    eh-raise-event "select-solution"  (1 + ticks) lv-next-col  task [pm-select-solution] 
                                  ]
  ] [eh-catch ticks self "select-solution" error-message ]
end
;;
to pm-check-halt
  carefully [
    if not (is-a-record? self and "scribe" = dm-cohort)  [error (word self dm-cohort " was expected to be the scribe agent to check end calculus condition!")]
    let cn-strike count (gv-headers with [true = dm-strikethrough?] )
    if bu-verify-mode? [show (word rpt-cron rpt-who self " DEBUG!  checking if we are finished... stroken lines : " cn-strike " dim:"  bu-dim)]
    ifelse cn-strike < bu-dim  [ eh-raise-event "reduce-minor"       (1 + ticks) gv-scribe task [pm-reduce-minor]     ]  
                               [ 
                                 mt-label-cost-matrix "original"
                                 set dm-cost 0
                                 set label (word "min-cost" precision dm-cost 1)
                                 set color red
                                 eh-raise-event "select-solution"       (1 + ticks) rpt-prior  task [pm-select-solution] 
                               ]  
    update-plots
  ] [eh-catch ticks self "check-halt" error-message ]
end
;;
to pm-reduce-line
  carefully [
    if not (is-a-record? self and "header" = dm-cohort) [error (word self label " expected to be a header so to reduce a matrix line!")]
    let lv-min rpt-reduce rpt-my-array "full" task [set hidden? false if not (false = dm-strikethrough?)  [error (word self label  " found strokethrough! ")] ]
    mt-label-cost-matrix "reduced"
  ] [eh-catch ticks self "reduce-line "  error-message ]
end
;;
to pm-reduce-minor
  carefully [
    if not (is-a-record? self and "scribe" = dm-cohort) [error (word self label " expected to be the scribe so to reduce minor!")]
    let lv-min rpt-reduce gv-reduced-matrix with [(false = dm-strikethrough?) ] task [set hidden? false]
    mt-label-cost-matrix "reduced"
    eh-raise-event "recover-cells"       (1 + ticks) gv-scribe    task [pm-recover-cells lv-min]
  ] [eh-catch ticks self "reduce-minor"  error-message ]
end
;;
to pm-recover-cells [#min]
   carefully [
    if not (is-a-record? self and "scribe" = dm-cohort) [error (word self label " expected to be the scribe so to recover double stroke cells!")]
    let lv-minor rpt-intersection-covered-cells
    if bu-verify-mode? [show (word rpt-cron lv-minor " DEBUG!  recovering " count lv-minor " double strokethrough cells ... min:" precision #min 1)]
    ask lv-minor  [
      set dm-cost (#min + dm-cost) set label precision dm-cost 1
      if (dm-cost < 0) [error (word dm-cohort "[" dm-bulldozer "," dm-site "] cost is not recovered properly " dm-cost)]
      if bu-verify-mode? [show (word rpt-cron " DEBUG! strikethrough element " rpt-who self " incremented cost to " precision dm-cost 1  " vs original:" precision (rpt-original dm-bulldozer dm-site) 1) ]
    ]
    mt-label-cost-matrix "original"
    eh-raise-event "strike"        (1 + ticks) gv-scribe                           task [pm-decide-strikethrough]
   ]  [eh-catch ticks self  "recover-cells "  error-message ]
end
;;
to pm-decide-strikethrough
  carefully [
    if not (is-a-record? self and "scribe" = dm-cohort) [error (word self label " was expected to be the scribe so to select which line to strike in the reduced matrix!")]
    let lv-candidate rpt-next-strike-candidate
    ifelse  (nobody = lv-candidate) [eh-raise-event "check-halt"      (1 + ticks) gv-scribe     task [pm-check-halt]   ]
                                    [eh-raise-event "execute-strike"  (1 + ticks) lv-candidate  task [pm-execute-strike]   ]
  ] [eh-catch ticks self  "pm-decide-strikethrough"   error-message ]
end
;;
to pm-execute-strike
  carefully [
    if not (is-a-record? self and "header" = dm-cohort) [error (word self rpt-who self " was expected to be a header so to strike my line in the reduced matrix!")]
    if count ((rpt-my-array "uncovered") with [0 = dm-cost]) != dm-cost [error (word self rpt-who self " mismatch count of uncovered zeros in this line " dm-cost) ]
    if bu-verify-mode? [
      show (word rpt-cron rpt-who self " DEBUG! will strike line  with " count (rpt-my-array "uncovered") " non yet stroken items, because it contains " dm-cost " null items.") 
    ]
    ask rpt-my-array "uncovered" [
      set dm-strikethrough? true set color violet
      if bu-verify-mode? [show (word rpt-cron " DEBUG! strikethrough element " rpt-who self ) ]
    ]
    set dm-strikethrough? true 
    set color violet
    if bu-verify-mode? [ show (word rpt-cron rpt-who self " DEBUG! count strike lines " count (gv-headers with [true = dm-strikethrough?] ) )]
    eh-raise-event "strike"                   (1 + ticks) gv-scribe                           task [pm-decide-strikethrough]
    mt-label-cost-matrix "reduced"
  ] [eh-catch ticks self  "pm-execute-strikethrough"   error-message ]
end
;;
to mt-count-uncovered-zeroes
  carefully [
    if not (is-a-record? self and "header" = dm-cohort) [error (word self label " expected to be a header so to count zeroes of reduced matrix!")]
    set dm-cost count ((rpt-my-array "uncovered") with [0 = dm-cost ] )
    mt-label-cost-matrix "reduced"
    if bu-verify-mode?  [show (word rpt-cron rpt-who self " DEBUG! num of zeros in this matrix line: " dm-cost  " strike? " dm-strikethrough?) ]
  ] [eh-catch ticks self  "count uncovered zeroes in a line"   error-message ]
end
;;
to mt-label-patch [#row #col]
  if not is-a-record? self [error (word self " was expected to be of breed records ... found " breed)]
  if (#row != 0 ) and (#col != 0) [error (word self dm-cohort " is expected to have either its row or column null!")]
  ask patch-here [
    set plabel ifelse-value (0 = #col) [ifelse-value (0 = #row) [dm-zone]  [(word "bulldozer_" #row)] ] [(word "site_" #col)]
  ]
end
;;
to mt-label-cost-matrix [#which]
  if not member? #which (list "original" "reduced") [error (word #which " is not a valid argument in mt-label-cost-matrix!")]
  let lv-lane patches with [ "COST-MATRIX" = dm-zone]
  ask records-on lv-lane [set hidden? true]
  set gv-reduced-matrix (records-on lv-lane ) with [  "clone-cost-matrix"  = dm-cohort ] 
  ask gv-reduced-matrix [
    set hidden? ("original" = #which) 
    if ("original" = #which) [set dm-strikethrough? false] 
    set label precision dm-cost 1 set label-color black
    set color ifelse-value (false = dm-strikethrough?) [ifelse-value (0 = dm-cost) [red] [yellow]] [violet]
  ]
  set gv-original-matrix (records-on lv-lane ) with [  "original-cost-matrix"  = dm-cohort ] 
  ask gv-original-matrix [
    set hidden? not ("original" = #which) set label precision dm-cost 1 set color ifelse-value (0 = dm-cost) [red] [blue]
  ]
  set gv-headers  (records-on lv-lane)  with ["header" = dm-cohort]  
  ask gv-headers [
    set hidden?  ("original" = #which)
    ifelse  ("original" = #which) [set dm-strikethrough? false   mt-label-patch  dm-bulldozer dm-site] [set plabel ""]
    set color ifelse-value (false = dm-strikethrough?) [ifelse-value (0 = dm-cost) [green] [orange]] [violet]
    set label (word "# " dm-cost) 
  ]
  set gv-scribe (records-on lv-lane) with ["scribe" = dm-cohort ]
  ask gv-scribe [set hidden?  ("original" = #which) set label "" set color gray ask patch-here [set plabel ifelse-value ("original" = #which) [dm-zone] [""]] ]
end
;;
to mt-data-entry
  if bu-fat-selector != "non-FAT" [
    let tb-fat (list "FAT#1" "FAT#2"  "FAT#3")
    let tb-dim (list  4        3         4)
    if not member? bu-fat-selector tb-fat [error (word " mismatch between choice test FAT selector " bu-fat-selector " and the defined FAT test in code: " tb-fat)]
    let lv-pos position bu-fat-selector tb-fat
    set bu-dim item lv-pos tb-dim
  ]
  foreach n-values (1 + bu-dim) [?] [mt-init-location ?]
end
;;
to mt-init-location [#location] 
  foreach n-values (1 + bu-dim) [?] [mt-init-assignee #location ?]
end
;;
to mt-init-assignee [#location #assignee]
  ask patch (-7 + (3 * #location)) (10 - (2 * #assignee) )  [
    set dm-zone "COST-MATRIX"
    ask (patch-set self neighbors) [set pcolor gray]
    set plabel-color white 
    sprout-records 1 [
      set dm-site #location set dm-bulldozer #assignee  set dm-strikethrough? false
      ifelse   (0 = #location)  or (0 = #assignee)   [  
        set dm-cohort ifelse-value ((0 = #location)  and (0 = #assignee)) ["scribe"] ["header"] 
        set hidden? true 
        set color orange
      ] [
        set dm-cohort "original-cost-matrix"
        set color blue set size 1.5
        set dm-cost rpt-gather-cell  #assignee #location
        set label dm-cost
        hatch-records 1 [set color yellow set hidden? true set dm-cohort "clone-cost-matrix"]
      ]
      if bu-verify-mode? [show (word dm-cohort " DEBUG!  cost for machine:" #assignee  " location: " #location " ==> cost:" dm-cost  )]
    ]
  ]
end
;;
to-report rpt-original [#row #col]
  let lv-cell gv-original-matrix  with [ (dm-bulldozer = #row) and (dm-site = #col)] 
  if 1 != count lv-cell [error (word " cost cell [" #row ", "   #col "] should be a unique instance! found : " count lv-cell)]
  report [dm-cost] of one-of lv-cell
end
;;
to-report rpt-intersection-covered-cells
  let tb-selected-cells []
  ask gv-headers  with [(0 = dm-bulldozer)  and (true = dm-strikethrough?)] [
    let lv-covered-col dm-site
    ask gv-headers  with [(0 = dm-site) and (true = dm-strikethrough?)] [
      let lv-covered-row dm-bulldozer
      let lv-double-covered-cell gv-reduced-matrix  with [(dm-bulldozer = lv-covered-row) and (dm-site = lv-covered-col) ]
      ask lv-double-covered-cell [
        if not (true = dm-strikethrough?) [error (word self rpt-who self  " whose cost is " dm-cost " was expected to be covered by a line! found: " dm-strikethrough?)]
      ]
      if bu-verify-mode? [show (word rpt-cron rpt-who self " DEBUG!  inserted in the list of double covered cells.")]
      set tb-selected-cells fput lv-double-covered-cell tb-selected-cells
    ]
  ]
  if empty? tb-selected-cells [report no-turtles]
  report turtle-set tb-selected-cells
end
;;
to-report rpt-prior
  let lv-candidates gv-headers with [ 0 = dm-bulldozer and false = dm-strikethrough?]
  report min-one-of lv-candidates [count (rpt-my-array "uncovered") with [0 = dm-cost]]
end
;;
to-report rpt-next-strike-candidate
  ask gv-headers    [mt-count-uncovered-zeroes]
  let lv-candidates gv-headers with [(0 < dm-cost) and (false = dm-strikethrough?)] 
  if bu-verify-mode? [
    let lv-max ifelse-value any? lv-candidates [ max [dm-cost] of lv-candidates ]  [0]
    show (word  " DEBUG!  strike through lines with major density of zeroes; candidates " count lv-candidates  " Max:" lv-max " covered lines:" count gv-headers with [ true = dm-strikethrough? ])
  ]
  report max-one-of lv-candidates [dm-cost]
end
;;
to-report rpt-my-headers
  if not (is-a-record? self)  [error (word self rpt-who self " was expected to be a record, in order to gather its headers!")] 
  let lv-my-headers gv-headers with [ (dm-bulldozer = [dm-bulldozer] of myself)  or  (dm-site = [dm-site] of myself) ] 
  if (2 != count lv-my-headers) [error (word self rpt-who self " my headers:" lv-my-headers  " expected to have 2 items, one for row, other for column! found: " count lv-my-headers)]
  report  lv-my-headers
end
;;
to-report rpt-my-row-col
  if not (is-a-record? self)  [error (word self dm-cohort " was expected to be a record, in order to gather its row and column!")] 
  if bu-verify-mode? [show (word rpt-cron rpt-who self " DEBUG! selects its row " dm-bulldozer  " and column " dm-site)]
  let lv-my-row records with [(dm-cohort = [dm-cohort] of myself) and (dm-bulldozer = [dm-bulldozer] of myself) ]
  let lv-my-col records with [(dm-cohort = [dm-cohort] of myself) and (dm-site = [dm-site] of myself)  ]
  if (count lv-my-col != bu-dim)  or (count lv-my-row != bu-dim) [error (word self " invalid dimension of my row or my column; expected : " bu-dim)]
  report (turtle-set  lv-my-row (other lv-my-col) )
end
;;
to-report rpt-my-array [#rule]
  if not member? #rule (list "uncovered" "full" )  [error (word #rule " is invalid!")]
  if not ( ("header" = dm-cohort) and  ((0 = dm-bulldozer) or (0 = dm-site))  )  [error (word self dm-cohort "[" dm-bulldozer "," dm-site  "]  can not obtain either a column or a row!")]
  let pm-field        ifelse-value (0 = dm-site)  [task [dm-bulldozer]] [task [dm-site] ]
  let lv-line         ifelse-value (0 = dm-site)  [dm-bulldozer] [dm-site] 
  if ("full" = #rule) [ report gv-reduced-matrix with [ lv-line = runresult pm-field ] ]
  report gv-reduced-matrix with [ (lv-line = runresult pm-field)  and (false = dm-strikethrough?)] 
end
;;
to-report rpt-reduce [#minor #check]
  if not (is-turtle-set? #minor)  [error (word #minor " was expected to be a set of records!")] 
  if not (is-command-task? #check) [error (word #check " was expected to be a check command task to apply to each cell in the minor!")]
  if not any? #minor [error (word #minor " degradated minor condition!  can not work out a solution for this cost matrix.")]
  let lv-min min [dm-cost] of #minor
  if (lv-min < 0 )  [error (word " cost matrix should not have negative cells; found " lv-min " when reducing a minor.")]
  ask #minor [
    run #check
    set dm-cost (dm-cost - lv-min) set label precision dm-cost 1 set hidden? false
    if bu-verify-mode? [show (word rpt-cron  " DEBUG! reducing minor " rpt-who self " to cost :"  precision dm-cost 1 " original cost cell " (rpt-original dm-bulldozer dm-site) ) ]
    if (dm-cost < 0) [error (word self dm-cohort " is not allowed to take a negative cost!" dm-cost)] 
  ]
  if bu-verify-mode? [show (word rpt-cron rpt-who self " DEBUG!  reduced minor of " count #minor " cells, by substracting " precision lv-min 2)]
  report lv-min
end
;;
to-report rpt-valid-input?  [#lb #ub]
  if not (is-a-part? self and "data-entry" = dm-cohort)  [error (word self dm-cohort " was expected to be a data-entry part!")]
  move-to one-of patches with ["departure" = dm-zone]
  if bu-verify-mode? [show (word label " DEBUG! rpt-valid-input? receives input " dm-value " low bound: " #lb  " upper bound:" #ub)]
  if (is-number? dm-value) and (#lb <= dm-value) and (dm-value <= #ub)  [report true]
  user-message (word dm-value " expected to be a number within the range [" #lb  ", " #ub "]" )
  report false
end
;;
to-report rpt-input [#inquiry #valid-input?]
  let lv-input read-from-string user-input  #inquiry
  let lv-valid? false
  ask one-of patches with ["arrival" = dm-zone] [
    sprout-entities 1 [
      set dm-cohort "data-entry"
      set label #inquiry
      set color green
      set dm-value lv-input
      if bu-verify-mode? [show (word " DEBUG! rpt-input reads  " dm-value)]
      set lv-valid? runresult #valid-input?  
      die
    ]
  ]
  if lv-valid? [report lv-input]
  report rpt-input #inquiry #valid-input?
end
;;
to-report rpt-gather-cell [#row #col]
  if bu-fat-selector = "FAT#1" [
    if bu-dim != 4 [error (word bu-fat-selector " needs 4 as predefined dimension!")]
    let lv-row1 [ 90  75 75  80]
    let lv-row2 [ 35  85 55  65]
    let lv-row3 [125  95 90 105]
    let lv-row4 [ 45 110 95 115]
    let lv-matrix (list lv-row1 lv-row2 lv-row3 lv-row4)
    let lv-my-row item (#row - 1) lv-matrix
    report item (#col - 1) lv-my-row
  ]
  if bu-fat-selector = "FAT#2" [
    ; http://www.math.harvard.edu/archive/20_spring_05/handouts/assignment_overheads.pdf
    if bu-dim != 3 [error (word bu-fat-selector " needs 3 as predefined dimension!")]
    let lv-row1 [ 250 400 350]
    let lv-row2 [ 400 600 350]
    let lv-row3 [ 200 400 250]
    let lv-matrix (list lv-row1 lv-row2 lv-row3 )
    let lv-my-row item (#row - 1) lv-matrix
    report item (#col - 1) lv-my-row
  ]
  if bu-fat-selector = "FAT#3" [
    ; http://www.universalteacherpublications.com/univ/ebooks/or/Ch6/hungar.htm
    if bu-dim != 4 [error (word bu-fat-selector " needs 4 as predefined dimension!")]
    let lv-row1 [ 20 25 22 28]
    let lv-row2 [ 15 18 23 17]
    let lv-row3 [ 19 17 21 24]
    let lv-row4 [ 25 23 24 24]
    let lv-matrix (list lv-row1 lv-row2 lv-row3 lv-row4)
    let lv-my-row item (#row - 1) lv-matrix
    report item (#col - 1) lv-my-row
  ]
  if bu-automatic-config? [ report precision (0.1 + random-float 56) 2]
  report rpt-input  (word " enter positive cost to move bulldozer " #row " to site " #col " :") task [rpt-valid-input? 0 1e22 ]
end
;;
to-report rpt-neighbors-on? [#where]
  report reduce [?1 and (?2 = "FEL")] (fput true [dm-zone] of neighbors)
end
;;
to-report rpt-next-event
  let lv-lane patches with ["FEL" = dm-zone]
  let lv-candidates (handlers-on lv-lane)  
  let lv-next-event min [dm-next-event] of lv-candidates
  if lv-next-event <=  ticks [error (word lv-next-event " scheduled in the past!")]
  report lv-next-event
end
;;
to-report rpt-who [#record]
  if not (is-a-record? #record) [error (word #record " was expected to be a record!")]
  report (word " " [dm-cohort] of #record "[" [dm-bulldozer] of #record ","  [dm-site] of #record  "] ")
end
;;
to-report rpt-cron
  report (word " Cron, "  precision ticks 1 ", " )
end
;;
@#$#@#$#@
GRAPHICS-WINDOW
210
10
649
470
16
16
13.0
1
10
1
1
1
0
0
0
1
-16
16
-16
16
1
1
1
CRON
30.0

BUTTON
30
36
96
69
NIL
setup
NIL
1
T
OBSERVER
NIL
NIL
NIL
NIL
1

BUTTON
31
82
94
115
go
go
T
1
T
OBSERVER
NIL
NIL
NIL
NIL
0

BUTTON
112
82
175
115
step
go
NIL
1
T
OBSERVER
NIL
NIL
NIL
NIL
0

SWITCH
29
131
191
164
bu-verify-mode?
bu-verify-mode?
0
1
-1000

SWITCH
20
290
200
323
bu-automatic-config?
bu-automatic-config?
0
1
-1000

OUTPUT
678
25
1381
79
12

CHOOSER
28
228
166
273
bu-fat-selector
bu-fat-selector
"non-FAT" "FAT#1" "FAT#2" "FAT#3"
3

SLIDER
16
180
199
213
bu-dim
bu-dim
3
7
4
1
1
matrix dimension
HORIZONTAL

@#$#@#$#@
## WHAT IS IT?

A special algorithm for the assignment problem. (Hungarian method)

Theorem:
If a number is added to or subtracted from all
of the entries of any one row or column of a cost matrix,
then on optimal assignment for the resulting cost matrix
is also an optimal assignment for the original cost matrix.

The Hungarian Method:
The following algorithm applies the above theorem to a given n * n  cost matrix to find an optimal assignment.
Step 1.
Subtract the smallest entry in each row from all the entries of its row.
Step 2.
Subtract the smallest entry in each column from all the entries of its column.
Step 3.
Draw lines through appropriate rows and columns so that all the zero entries of the cost matrix are covered and the minimum number of  such lines is used.
Step 4.
Test for Optimality:
(i) If the minimum number of covering lines is  n, an optimal assignment of zeros is possible and we are finished. 
(ii) If the minimum number of covering lines is less than n, an optimal assignment of zeros is not yet possible. In that case, proceed to Step 5.
Step 5.
Determine the smallest entry not covered by any line. Subtract this entry from each uncovered row, and then add it to each covered column. Return to Step 3.

EXAMPLE:  A construction company has four large
bulldozers located at four different garages. The bulldozers
are to be moved to four different construction sites. The
distances in miles between the bulldozers and the
construction sites are given below.

How should the bulldozers be moved to the construction sites
in order to minimize the total distance traveled?

NB: The system  provides a general model for the Hungarian method.

## HOW IT WORKS

The cost matrix is made visible in the habitat.
There are some breeds of turtles; mainly  handlers and records.

Records are used to store the cost matrix and to perform the calculations.
We manage the original matrix, which remains constant with its cost data cells; and a clone which evolves over time to  carry the heuristics so to search the solution.

Handlers are used either to manage exceptions, and also to drive the evolution of the system state over time by emulating the typical artifact of a Future Event List.

## HOW TO USE IT

Before pressing the setup button you decide  if you want to run a FAT test (predefined tests used to verify the system behavior because we know the result the system must discover).  You can also decide the dimension of the cost matrix, and choose to enter data manually or ask it to be created randomly.

You can also decide with a switch  is you want to track in the command center (log)  all the details of what the system is doing. This is specially useful to debug the code.

You the press setup followed by the go button.

The  system will evolve  by showing the calculation matrix, and  finally will halt by showing back the original cost matrix with the selected cells in green color for the optimal solution achieved.

## THINGS TO NOTICE

Look at the code so to see the  orientation to  preventive quality in software developing.

You will see the managing exceptions applied policy.

You can also get interested in the way of emulating a future event list  with a breed of turtles.

You can also get interested in the way of using sort of lambdas  (command tasks and reporter tasks) so to emulate to some extent the polimorphism that we have in OOP languages.

## THINGS TO TRY

Use data that can provoke malconditioned matrix or non feasible solutions.
Explote the system with acid testing and try to find potential system malfunctions.

Use examples with known solution for additional SAT testing.

Use the SOLVER of a spreadsheet to  cross check results.

## EXTENDING THE MODEL

You can readjust  the placement of the matrix so to be able to  manage larger cost matrices.  Dimension could be arbitrary,  but is here limited  by the presentation layer, so that the observer can see the overall matrix with a glance.

## NETLOGO FEATURES

Managing exceptions, lambdas, future event list, cohorts of breeds to discriminate among subsets of breed populations.

## RELATED MODELS

NetLogo Models Library is a powerful source for learning many of the features used here in this work.

## CREDITS AND REFERENCES

http://www.cs.berkeley.edu/~vazirani/algorithms/chap8.pdf

http://ia700502.us.archive.org/15/items/algorithmfortrav00litt/algorithmfortrav00litt_bw.pdf

http://www.youtube.com/watch?v=LjvdXKsvUpU

http://www.math.harvard.edu/archive/20_spring_05/handouts/assignment_overheads.pdf

http://www.universalteacherpublications.com/univ/ebooks/or/Ch6/hungar.htm

Hillier, F. S. and Lieberman, G. J. Introduction to Operations Research, 8th ed. New York: McGraw-Hill, 1990. 

Author: Jose Costas.   September, 2013.
@#$#@#$#@
default
true
0
Polygon -7500403 true true 150 5 40 250 150 205 260 250

airplane
true
0
Polygon -7500403 true true 150 0 135 15 120 60 120 105 15 165 15 195 120 180 135 240 105 270 120 285 150 270 180 285 210 270 165 240 180 180 285 195 285 165 180 105 180 60 165 15

arrow
true
0
Polygon -7500403 true true 150 0 0 150 105 150 105 293 195 293 195 150 300 150

box
false
0
Polygon -7500403 true true 150 285 285 225 285 75 150 135
Polygon -7500403 true true 150 135 15 75 150 15 285 75
Polygon -7500403 true true 15 75 15 225 150 285 150 135
Line -16777216 false 150 285 150 135
Line -16777216 false 150 135 15 75
Line -16777216 false 150 135 285 75

bug
true
0
Circle -7500403 true true 96 182 108
Circle -7500403 true true 110 127 80
Circle -7500403 true true 110 75 80
Line -7500403 true 150 100 80 30
Line -7500403 true 150 100 220 30

butterfly
true
0
Polygon -7500403 true true 150 165 209 199 225 225 225 255 195 270 165 255 150 240
Polygon -7500403 true true 150 165 89 198 75 225 75 255 105 270 135 255 150 240
Polygon -7500403 true true 139 148 100 105 55 90 25 90 10 105 10 135 25 180 40 195 85 194 139 163
Polygon -7500403 true true 162 150 200 105 245 90 275 90 290 105 290 135 275 180 260 195 215 195 162 165
Polygon -16777216 true false 150 255 135 225 120 150 135 120 150 105 165 120 180 150 165 225
Circle -16777216 true false 135 90 30
Line -16777216 false 150 105 195 60
Line -16777216 false 150 105 105 60

car
false
0
Polygon -7500403 true true 300 180 279 164 261 144 240 135 226 132 213 106 203 84 185 63 159 50 135 50 75 60 0 150 0 165 0 225 300 225 300 180
Circle -16777216 true false 180 180 90
Circle -16777216 true false 30 180 90
Polygon -16777216 true false 162 80 132 78 134 135 209 135 194 105 189 96 180 89
Circle -7500403 true true 47 195 58
Circle -7500403 true true 195 195 58

circle
false
0
Circle -7500403 true true 0 0 300

circle 2
false
0
Circle -7500403 true true 0 0 300
Circle -16777216 true false 30 30 240

cow
false
0
Polygon -7500403 true true 200 193 197 249 179 249 177 196 166 187 140 189 93 191 78 179 72 211 49 209 48 181 37 149 25 120 25 89 45 72 103 84 179 75 198 76 252 64 272 81 293 103 285 121 255 121 242 118 224 167
Polygon -7500403 true true 73 210 86 251 62 249 48 208
Polygon -7500403 true true 25 114 16 195 9 204 23 213 25 200 39 123

cylinder
false
0
Circle -7500403 true true 0 0 300

dot
false
0
Circle -7500403 true true 90 90 120

face happy
false
0
Circle -7500403 true true 8 8 285
Circle -16777216 true false 60 75 60
Circle -16777216 true false 180 75 60
Polygon -16777216 true false 150 255 90 239 62 213 47 191 67 179 90 203 109 218 150 225 192 218 210 203 227 181 251 194 236 217 212 240

face neutral
false
0
Circle -7500403 true true 8 7 285
Circle -16777216 true false 60 75 60
Circle -16777216 true false 180 75 60
Rectangle -16777216 true false 60 195 240 225

face sad
false
0
Circle -7500403 true true 8 8 285
Circle -16777216 true false 60 75 60
Circle -16777216 true false 180 75 60
Polygon -16777216 true false 150 168 90 184 62 210 47 232 67 244 90 220 109 205 150 198 192 205 210 220 227 242 251 229 236 206 212 183

fish
false
0
Polygon -1 true false 44 131 21 87 15 86 0 120 15 150 0 180 13 214 20 212 45 166
Polygon -1 true false 135 195 119 235 95 218 76 210 46 204 60 165
Polygon -1 true false 75 45 83 77 71 103 86 114 166 78 135 60
Polygon -7500403 true true 30 136 151 77 226 81 280 119 292 146 292 160 287 170 270 195 195 210 151 212 30 166
Circle -16777216 true false 215 106 30

flag
false
0
Rectangle -7500403 true true 60 15 75 300
Polygon -7500403 true true 90 150 270 90 90 30
Line -7500403 true 75 135 90 135
Line -7500403 true 75 45 90 45

flower
false
0
Polygon -10899396 true false 135 120 165 165 180 210 180 240 150 300 165 300 195 240 195 195 165 135
Circle -7500403 true true 85 132 38
Circle -7500403 true true 130 147 38
Circle -7500403 true true 192 85 38
Circle -7500403 true true 85 40 38
Circle -7500403 true true 177 40 38
Circle -7500403 true true 177 132 38
Circle -7500403 true true 70 85 38
Circle -7500403 true true 130 25 38
Circle -7500403 true true 96 51 108
Circle -16777216 true false 113 68 74
Polygon -10899396 true false 189 233 219 188 249 173 279 188 234 218
Polygon -10899396 true false 180 255 150 210 105 210 75 240 135 240

house
false
0
Rectangle -7500403 true true 45 120 255 285
Rectangle -16777216 true false 120 210 180 285
Polygon -7500403 true true 15 120 150 15 285 120
Line -16777216 false 30 120 270 120

leaf
false
0
Polygon -7500403 true true 150 210 135 195 120 210 60 210 30 195 60 180 60 165 15 135 30 120 15 105 40 104 45 90 60 90 90 105 105 120 120 120 105 60 120 60 135 30 150 15 165 30 180 60 195 60 180 120 195 120 210 105 240 90 255 90 263 104 285 105 270 120 285 135 240 165 240 180 270 195 240 210 180 210 165 195
Polygon -7500403 true true 135 195 135 240 120 255 105 255 105 285 135 285 165 240 165 195

line
true
0
Line -7500403 true 150 0 150 300

line half
true
0
Line -7500403 true 150 0 150 150

pentagon
false
0
Polygon -7500403 true true 150 15 15 120 60 285 240 285 285 120

person
false
0
Circle -7500403 true true 110 5 80
Polygon -7500403 true true 105 90 120 195 90 285 105 300 135 300 150 225 165 300 195 300 210 285 180 195 195 90
Rectangle -7500403 true true 127 79 172 94
Polygon -7500403 true true 195 90 240 150 225 180 165 105
Polygon -7500403 true true 105 90 60 150 75 180 135 105

plant
false
0
Rectangle -7500403 true true 135 90 165 300
Polygon -7500403 true true 135 255 90 210 45 195 75 255 135 285
Polygon -7500403 true true 165 255 210 210 255 195 225 255 165 285
Polygon -7500403 true true 135 180 90 135 45 120 75 180 135 210
Polygon -7500403 true true 165 180 165 210 225 180 255 120 210 135
Polygon -7500403 true true 135 105 90 60 45 45 75 105 135 135
Polygon -7500403 true true 165 105 165 135 225 105 255 45 210 60
Polygon -7500403 true true 135 90 120 45 150 15 180 45 165 90

sheep
false
15
Circle -1 true true 203 65 88
Circle -1 true true 70 65 162
Circle -1 true true 150 105 120
Polygon -7500403 true false 218 120 240 165 255 165 278 120
Circle -7500403 true false 214 72 67
Rectangle -1 true true 164 223 179 298
Polygon -1 true true 45 285 30 285 30 240 15 195 45 210
Circle -1 true true 3 83 150
Rectangle -1 true true 65 221 80 296
Polygon -1 true true 195 285 210 285 210 240 240 210 195 210
Polygon -7500403 true false 276 85 285 105 302 99 294 83
Polygon -7500403 true false 219 85 210 105 193 99 201 83

square
false
0
Rectangle -7500403 true true 30 30 270 270

square 2
false
0
Rectangle -7500403 true true 30 30 270 270
Rectangle -16777216 true false 60 60 240 240

star
false
0
Polygon -7500403 true true 151 1 185 108 298 108 207 175 242 282 151 216 59 282 94 175 3 108 116 108

target
false
0
Circle -7500403 true true 0 0 300
Circle -16777216 true false 30 30 240
Circle -7500403 true true 60 60 180
Circle -16777216 true false 90 90 120
Circle -7500403 true true 120 120 60

tree
false
0
Circle -7500403 true true 118 3 94
Rectangle -6459832 true false 120 195 180 300
Circle -7500403 true true 65 21 108
Circle -7500403 true true 116 41 127
Circle -7500403 true true 45 90 120
Circle -7500403 true true 104 74 152

triangle
false
0
Polygon -7500403 true true 150 30 15 255 285 255

triangle 2
false
0
Polygon -7500403 true true 150 30 15 255 285 255
Polygon -16777216 true false 151 99 225 223 75 224

truck
false
0
Rectangle -7500403 true true 4 45 195 187
Polygon -7500403 true true 296 193 296 150 259 134 244 104 208 104 207 194
Rectangle -1 true false 195 60 195 105
Polygon -16777216 true false 238 112 252 141 219 141 218 112
Circle -16777216 true false 234 174 42
Rectangle -7500403 true true 181 185 214 194
Circle -16777216 true false 144 174 42
Circle -16777216 true false 24 174 42
Circle -7500403 false true 24 174 42
Circle -7500403 false true 144 174 42
Circle -7500403 false true 234 174 42

turtle
true
0
Polygon -10899396 true false 215 204 240 233 246 254 228 266 215 252 193 210
Polygon -10899396 true false 195 90 225 75 245 75 260 89 269 108 261 124 240 105 225 105 210 105
Polygon -10899396 true false 105 90 75 75 55 75 40 89 31 108 39 124 60 105 75 105 90 105
Polygon -10899396 true false 132 85 134 64 107 51 108 17 150 2 192 18 192 52 169 65 172 87
Polygon -10899396 true false 85 204 60 233 54 254 72 266 85 252 107 210
Polygon -7500403 true true 119 75 179 75 209 101 224 135 220 225 175 261 128 261 81 224 74 135 88 99

wheel
false
0
Circle -7500403 true true 3 3 294
Circle -16777216 true false 30 30 240
Line -7500403 true 150 285 150 15
Line -7500403 true 15 150 285 150
Circle -7500403 true true 120 120 60
Line -7500403 true 216 40 79 269
Line -7500403 true 40 84 269 221
Line -7500403 true 40 216 269 79
Line -7500403 true 84 40 221 269

wolf
false
0
Polygon -16777216 true false 253 133 245 131 245 133
Polygon -7500403 true true 2 194 13 197 30 191 38 193 38 205 20 226 20 257 27 265 38 266 40 260 31 253 31 230 60 206 68 198 75 209 66 228 65 243 82 261 84 268 100 267 103 261 77 239 79 231 100 207 98 196 119 201 143 202 160 195 166 210 172 213 173 238 167 251 160 248 154 265 169 264 178 247 186 240 198 260 200 271 217 271 219 262 207 258 195 230 192 198 210 184 227 164 242 144 259 145 284 151 277 141 293 140 299 134 297 127 273 119 270 105
Polygon -7500403 true true -1 195 14 180 36 166 40 153 53 140 82 131 134 133 159 126 188 115 227 108 236 102 238 98 268 86 269 92 281 87 269 103 269 113

x
false
0
Polygon -7500403 true true 270 75 225 30 30 225 75 270
Polygon -7500403 true true 30 75 75 30 270 225 225 270

@#$#@#$#@
NetLogo 5.0.4
@#$#@#$#@
@#$#@#$#@
@#$#@#$#@
@#$#@#$#@
@#$#@#$#@
default
0.0
-0.2 0 1.0 0.0
0.0 1 1.0 0.0
0.2 0 1.0 0.0
link direction
true
0
Line -7500403 true 150 150 90 180
Line -7500403 true 150 150 210 180

@#$#@#$#@
0
@#$#@#$#@