Vogel's Approximation Method (VAM) is a technique for finding a good initial feasible solution to an allocation problem.

The powers that be have identified 5 tasks that need to be solved urgently. Being imaginative chaps, they have called them “A”, “B”, “C”, “D”, and “E”. They estimate that:

 A will require 30 hours of work,
 B will require 20 hours of work,
 C will require 70 hours of work,
 D will require 30 hours of work, and
 E will require 60 hours of work.
They have identified 4 contractors willing to do the work, called “W”, “X”, “Y”, and “Z”.

 W has 50 hours available to commit to working,
 X has 60 hours available,
 Y has 50 hours available, and
 Z has 50 hours available.
The cost per hour for each contractor for each task is summarized by the following table:

   A  B  C  D  E
W 16 16 13 22 17
X 14 14 13 19 15
Y 19 19 20 23 50
Z 50 12 50 15 11

The task is to use VAM to allocate contractors to tasks. It scales to large problems, so ideally keep sorts out of the iterative cycle. It works as follows:

Step 1: Balance the given transportation problem if either (total supply>total demand) or (total supply<total demand)
Step 2: Determine the penalty cost for each row and column by subtracting the lowest cell cost in the row or column from the next lowest cell cost in the same row or column.
Step 3: Select the row or column with the highest penalty cost (breaking ties arbitrarily or choosing the lowest-cost cell).
Step 4: Allocate as much as possible to the feasible cell with the lowest transportation cost in the row or column with the highest penalty cost.
Step 5: Repeat steps 2, 3 and 4 until all requirements have been meet.
Step 6: Compute total transportation cost for the feasible allocations.
For this task assume that the model is balanced.

For each task and contractor (row and column above) calculating the difference between the smallest two values produces:

        A       B       C       D       E       W       X       Y       Z
1       2       2       0       4       4       3       1       0       1   E-Z(50)

Determine the largest difference (D or E above). In the case of ties I shall choose the one with the lowest price (in this case E because the lowest price for D is Z=15, whereas for E it is Z=11). For your choice determine the minimum cost (chosen E above so Z=11 is chosen now). Allocate as much as possible from Z to E (50 in this case limited by Z's supply).
Adjust the supply and demand accordingly. If demand or supply becomes 0 for a given task or contractor it plays no further part. In this case Z is out of it. If you choose arbitrarily, and chose D see here for the working.

Repeat until all supply and demand is met:

2       2       2       0       3       2       3       1       0       -   C-W(50)
3       5       5       7       4      35       -       1       0       -   E-X(10)
4       5       5       7       4       -       -       1       0       -   C-X(20)
5       5       5       -       4       -       -       0       0       -   A-X(30)
6       -      19       -      23       -       -       -       4       -   D-Y(30)
        -       -       -       -       -       -       -       -       -   B-Y(20)

Finally calculate the cost of your solution. In the example given it is £3100:

   A  B  C  D  E
W       50
X 30    20    10
Y    20    30
Z             50

The optimal solution determined by GLPK is £3100:

   A  B  C  D  E
W       50
X 10 20 20    10
Y 20       30
Z             50

Cf.
 Transportation problem
/* REXX ***************************************************************
* Solve the Transportation Problem using Vogel's Approximation
Default Input
2 3        # of sources / # of demands
25 35      sources
20 30 10   demands
3 5 7      cost matrix    <
3 2 5
* 20201210 support no input file -courtesy GS
*          Note: correctness of input is not checked
* 20210102 restored Vogel's Approximation and added Optimization
* 20210103 eliminated debug code
**********************************************************************/
Signal On Halt
Signal On Novalue
Signal On Syntax
 
Parse Arg fid
If fid='' Then
  fid='input1.txt'
Call init
m.=0
Do Forever
  dmax.=0
  dmax=0
  Do r=1 To rr
    dr.r=''
    Do c=1 To cc
      If cost.r.c<>'*' Then
        dr.r=dr.r cost.r.c
      End
    dr.r=words(dr.r) dr.r
    dr.r=diff(dr.r)
    If dr.r>dmax Then Do; dmax=dr.r; dmax.0='R'; dmax.1=r; dmax.2=dr.r; End
    End
  Do c=1 To cc
    dc.c=''
    Do r=1 To rr
      If cost.r.c<>'*' Then
        dc.c=dc.c cost.r.c
      End
    dc.c=words(dc.c) dc.c
    dc.c=diff(dc.c)
    If dc.c>dmax Then Do; dmax=dc.c; dmax.0='C'; dmax.1=c; dmax.2=dc.c; End
    End
  cmin=999
  Select
    When dmax.0='R' Then Do
      r=dmax.1
      Do c=1 To cc
        If cost.r.c<>'*' &,
           cost.r.c<cmin Then Do
          cmin=cost.r.c
          cx=c
          End
        End
      Call allocate r cx
      End
    When dmax.0='C' Then Do
      c=dmax.1
      Do r=1 To rr
        If cost.r.c<>'*' &,
           cost.r.c<cmin Then Do
          cmin=cost.r.c
          rx=r
          End
        End
      Call allocate rx c
      End
    Otherwise
      Leave
    End
  End
 
Do r=1 To rr
  Do c=1 To cc
    If cost.r.c<>'*' Then Do
      Call allocate r c
      cost.r.c='*'
      End
    End
  End
 
Call show_alloc 'Vogel''s Approximation'
 
Do r=1 To rr
  Do c=1 To cc
    cost.r.c=word(matrix.r.c,3)   /* restore cost.*.* */
    End
  End
 
Call steppingstone
Exit
 
/**********************************************************************
* Subroutines for Vogel's Approximation
**********************************************************************/
 
init:
If lines(fid)=0 Then Do
  Say 'Input file not specified or not found. Using default input instead.'
  fid='Default input'
  in.1=sourceline(4)
  Parse Var in.1 numSources .
  Do i=2 To numSources+3
    in.i=sourceline(i+3)
    End
  End
Else Do
  Do i=1 By 1 while lines(fid)>0
    in.i=linein(fid)
    End
  End
Parse Var in.1 numSources numDestinations . 1 rr cc .
source.=0
demand.=0
source_sum=0
Do i=1 To numSources
  Parse Var in.2 source.i in.2
  ss.i=source.i
  source_in.i=source.i
  source_sum=source_sum+source.i
  End
l=linein(fid)
demand_sum=0
Do i=1 To numDestinations
  Parse Var in.3 demand.i in.3
  dd.i=demand.i
  demand_in.i=demand.i
  demand_sum=demand_sum+demand.i
  End
Do i=1 To numSources
  j=i+3
  l=in.j
  Do j=1 To numDestinations
    Parse Var l cost.i.j l
    End
  End
Do i=1 To numSources
  ol=format(source.i,3)
  Do j=1 To numDestinations
    ol=ol format(cost.i.j,4)
    End
  End
ol='   '
Do j=1 To numDestinations
  ol=ol format(demand.j,4)
  End
 
Select
  When source_sum=demand_sum Then Nop  /* balanced */
  When source_sum>demand_sum Then Do   /* unbalanced - add dummy demand */
    Say 'This is an unbalanced case (sources exceed demands). We add a dummy consumer.'
    cc=cc+1
    demand.cc=source_sum-demand_sum
    demand_in.cc=demand.cc
    dd.cc=demand.cc
    Do r=1 To rr
      cost.r.cc=0
      End
    End
  Otherwise /* demand_sum>source_sum */ Do /* unbalanced - add dummy source */
    Say 'This is an unbalanced case (demands exceed sources). We add a dummy source.'
    rr=rr+1
    source.rr=demand_sum-source_sum
    source_in.rr=source.rr
    ss.rr=source.rr
    Do c=1 To cc
      cost.rr.c=0
      End
    End
  End
 
Say 'Sources / Demands / Cost'
ol='    '
Do c=1 To cc
  ol=ol format(demand.c,3)
  End
Say ol
 
Do r=1 To rr
  ol=format(source.r,4)
  Do c=1 To cc
    ol=ol format(cost.r.c,3)
    matrix.r.c=r c cost.r.c 0
    End
  Say ol
  End
Return
 
allocate: Procedure Expose m. source. demand. cost. rr cc matrix.
Parse Arg r c
sh=min(source.r,demand.c)
source.r=source.r-sh
demand.c=demand.c-sh
m.r.c=sh
matrix.r.c=subword(matrix.r.c,1,3) sh
If source.r=0 Then Do
  Do c=1 To cc
    cost.r.c='*'
    End
  End
If demand.c=0 Then Do
  Do r=1 To rr
    cost.r.c='*'
    End
  End
Return
 
diff: Procedure
Parse Value arg(1) With n list
If n<2 Then Return 0
list=wordsort(list)
Return word(list,2)-word(list,1)
 
wordsort: Procedure
/**********************************************************************
* Sort the list of words supplied as argument. Return the sorted list
**********************************************************************/
  Parse Arg wl
  wa.=''
  wa.0=0
  Do While wl<>''
    Parse Var wl w wl
    Do i=1 To wa.0
      If wa.i>w Then Leave
      End
    If i<=wa.0 Then Do
      Do j=wa.0 To i By -1
        ii=j+1
        wa.ii=wa.j
        End
      End
    wa.i=w
    wa.0=wa.0+1
    End
  swl=''
  Do i=1 To wa.0
    swl=swl wa.i
    End
  /* Say swl */
  Return strip(swl)
 
show_alloc: Procedure Expose matrix. rr cc demand_in. source_in.
Parse Arg header
If header='' Then
  Return
Say ''
Say header
total=0
ol='    '
Do c=1 to cc
  ol=ol format(demand_in.c,3)
  End
Say ol
as=''
Do r=1 to rr
  ol=format(source_in.r,4)
  a=word(matrix.r.1,4)
  If a=0.0000000001 Then a=0
  If a>0 Then
    ol=ol format(a,3)
  Else
    ol=ol ' - '
  total=total+word(matrix.r.1,4)*word(matrix.r.1,3)
  Do c=2 To cc
    a=word(matrix.r.c,4)
    If a=0.0000000001 Then a=0
    If a>0 Then
      ol=ol format(a,3)
    Else
      ol=ol ' - '
    total=total+word(matrix.r.c,4)*word(matrix.r.c,3)
    as=as a
    End
  Say ol
  End
Say 'Total costs:' format(total,4,1)
Return
 
 
/**********************************************************************
* Subroutines for Optimization
**********************************************************************/
 
steppingstone: Procedure Expose matrix. cost. rr cc matrix. demand_in.,
                              source_in. ms fid move cnt.
maxReduction=0
move=''
Call fixDegenerateCase
Do r=1 To rr
  Do c=1 To cc
    Parse Var matrix.r.c r c cost qrc
    If qrc=0 Then Do
      path=getclosedpath(r,c)
      If pelems(path)<4 Then Do
        Iterate
        End
      reduction = 0
      lowestQuantity = 1e10
      leavingCandidate = ''
      plus=1
      pathx=path
      Do While pathx<>''
        Parse Var pathx s '|' pathx
        If plus Then
          reduction=reduction+word(s,3)
        Else Do
          reduction=reduction-word(s,3)
          If word(s,4)<lowestQuantity Then Do
            leavingCandidate = s
            lowestQuantity = word(s,4)
            End
          End
        plus=\plus
        End
      If reduction < maxreduction Then Do
        move=path
        leaving=leavingCandidate
        maxReduction = reduction
        End
      End
    End
  End
if move<>'' Then Do
  quant=word(leaving,4)
  If quant=0 Then Do
    Call show_alloc 'Optimum'
    Exit
    End
  plus=1
  Do While move<>''
    Parse Var move m '|' move
    Parse Var m r c cpu qrc
    Parse Var matrix.r.c vr vc vcost vquant
    If plus Then
      nquant=vquant+quant
    Else
      nquant=vquant-quant
    matrix.r.c = vr vc vcost nquant
    plus=\plus
    End
  move=''
  Call steppingStone
  End
Else
  Call show_alloc 'Optimal Solution' fid
Return
 
getclosedpath: Procedure Expose matrix. cost. rr cc matrix.
Parse Arg rd,cd
path=rd cd cost.rd.cd word(matrix.rd.cd,4)
do r=1 To rr
  Do c=1 To cc
    If word(matrix.r.c,4)>0 Then Do
      path=path'|'r c cost.r.c word(matrix.r.c,4)
      End
    End
  End
path=magic(path)
Return stones(path)
 
magic: Procedure
Parse Arg list
Do Forever
  list_1=remove_1(list)
  If list_1=list Then Leave
  list=list_1
  End
Return list_1
 
remove_1: Procedure
Parse Arg list
cntr.=0
cntc.=0
Do i=1 By 1 While list<>''
  parse Var list e.i '|' list
  Parse Var e.i r c .
  cntr.r=cntr.r+1
  cntc.c=cntc.c+1
  End
n=i-1
keep.=1
Do i=1 To n
  Parse Var e.i r c .
  If cntr.r<2 |,
     cntc.c<2 Then Do
    keep.i=0
    End
  End
list=e.1
Do i=2 To n
  If keep.i Then
    list=list'|'e.i
  End
Return list
 
stones: Procedure
Parse Arg lst
tstc=lst
Do i=1 By 1 While tstc<>''
  Parse Var tstc o.i '|' tstc
  end
stones=lst
o.0=i-1
prev=o.1
Do i=1 To o.0
  st.i=prev
  k=i//2
  nbrs=getNeighbors(prev,lst)
  Parse Var nbrs n.1 '|' n.2
  If k=0 Then
    prev=n.2
  Else
    prev=n.1
  End
stones=st.1
Do i=2 To o.0
  stones=stones'|'st.i
  End
Return stones
 
getNeighbors: Procedure Expose o.
parse Arg s, lst
Do i=1 To 4
  Parse Var lst o.i '|' lst
  End
nbrs.=''
sr=word(s,1)
sc=word(s,2)
Do i=1 To o.0
  If o.i<>s Then Do
    or=word(o.i,1)
    oc=word(o.i,2)
    If or=sr & nbrs.0='' Then
      nbrs.0 = o.i
    else if oc=sc & nbrs.1='' Then
      nbrs.1 = o.i
    If nbrs.0<>'' & nbrs.1<>'' Then
      Leave
    End
  End
return nbrs.0'|'nbrs.1
 
m1: Procedure
Parse Arg z
Return z-1
 
pelems: Procedure
Call Trace 'O'
Parse Arg p
n=0
Do While p<>''
  Parse Var p x '|' p
  If x<>'' Then n=n+1
  End
Return n
 
fixDegenerateCase: Procedure Expose matrix. rr cc ms
Call matrixtolist
If (rr+cc-1)<>ms Then Do
  Do r=1 To rr
    Do c=1 To cc
      If word(matrix.r.c,4)=0 Then Do
        matrix.r.c=subword(matrix.r.c,1,3) 1.e-10
        Return
        End
      End
    End
  End
Return
 
matrixtolist: Procedure Expose matrix. rr cc ms
ms=0
list=''
Do r=1 To rr
  Do c=1 To cc
    If word(matrix.r.c,4)>0 Then Do
      list=list'|'matrix.r.c
      ms=ms+1
      End
    End
  End
Return strip(list,,'|')
 
Novalue:
  Say 'Novalue raised in line' sigl
  Say sourceline(sigl)
  Say 'Variable' condition('D')
  Signal lookaround
 
Syntax:
  Say 'Syntax raised in line' sigl
  Say sourceline(sigl)
  Say 'rc='rc '('errortext(rc)')'
 
halt:
lookaround:
  If fore() Then Do
    Say 'You can look around now.'
    Trace ?R
    Nop
    End
  Exit 12