Transport Macro

Overview

In this example, supply and demand data for selected US cities is obtained from an Excel spreadsheet using Mathematica Link for Excel v 3.0.  Mathematica is then used to calculate and visualize the optimal shipping strategy. The end result for a sample study of ten supply cities and fifty demand cities is shown below.

Setup

Needs["ExcelLink`"]

Needs["Miscellaneous`WorldPlot`"]

Input

citytable  = ExcelRead[ExcelSheet["Input"]];

cityheaders = First[citytable]; 
    citydata  =  Rest[citytable];

Length[citydata]

Calculations

Visualizing

borderdata =  
        First[WorldData["USA"]]  /.  {lat_, lon_}   ->  {lon, lat}/
              60;

borderpoly  =  
        Graphics[{GrayLevel[ .8],  Polygon[borderdata]}];

citypoints =  
        Graphics[{Hue[ .8], AbsolutePointSize[4],  
            citydata /.  {city_String, state_, lat_, lon_, supply_, 
                  demand_} -> Point[{lon, lat}]}];

Show[{borderpoly, citypoints}]

Filtering

supplycities  =  
        Select[citydata,  Part[#, 5] > 0  &];

demandcities  =  
        Select[citydata,  Part[#, 6] > 0  &];

Length  /@  {supplycities,  demandcities}

supplypoints =  
        Graphics[{Hue[ .3],  AbsolutePointSize[5],  
            supplycities /.  {city_String, state_, lat_, lon_, supply_, 
                  demand_} :> Point[{lon, lat}]}];

demandpoints =  
      Graphics[{Hue[ .8], AbsolutePointSize[4], 
          demandcities /.  {city_String, state_, lat_, lon_, supply_, 
                demand_} :> Point[{lon, lat}]}]

Show[borderpoly, supplypoints,  demandpoints]

Shipments

Off[General::spell1]

\(TransportationProblem[costs_, supplies_, 
        demands_] := 
\ \ Module[{c, b, n, m, sbase, dbase, sconstraints, 
          dconstraints, a}, 
\ \ \ \ c\  = \ 
          Flatten[costs]; 
\ \ \ \ b\  = \ 
          Join[\(-supplies\), demands]; 
\ \ \ \ n\  = \ 
          Length[supplies]; 
\ \ \ \ m\  = \ 
          Length[demands]; 
\ \ \ \ sbase\  = \ 
          Join[Table[\(-1\), {m}], 
            Table[0, {m*\((n - 1)\)}]]; \ 
\ \ \ \ dbase\  = 
          Flatten[\ 
            Table[Join[{1}, 
                Table[0, {m - 1}]], {n}]]; \ 
\ \ \ \ sconstraints\  = \ 
          Table[RotateRight[sbase, \ m*i], {i, 0, 
              n - 1}]; 
\ \ \ \ dconstraints\  = \ 
          Table[RotateRight[dbase, \ i], {i, 0, m - 1}]; 
\ \ \ \ a\  = \ 
          Join[sconstraints, dconstraints]; 
\ \ \ \ Partition[
          LinearProgramming[c, \ a, \ b], \ m]
\ \ ]\)

\(CalculateDistances[s_, \ d_] := \ 

      Table[\ Sqrt[\ \((s[\([i, 1]\)] - 
                  d[\([j, 1]\)])\)^2\  + \ \((s[\([i, 2]\)] - 
                  d[\([j, 2]\)])\)^2\ ], {i, 1, Length[s]}, {j, 1, 
          Length[d]}]\)

\(\(Arcs[qarcs_, \ scoords_, \ dcoords_]\  := 
\ \ Graphics[
          Table[
		With[{q = qarcs[\([i, j]\)], sxy = scoords[\([i]\)], 
                dxy = dcoords[\([j]\)]}, 
\ \ \ \ \ \ \ \ If[
                Chop[q] == 
                  0, 
\ \ \ \ \ \ \ \ \ \ {}, 
	\ \ \ \ \ \ \ {Line[{sxy, \ dxy}]}
\ \ \ \ \ \ \ \ ]], 
\ \ {i, 1, Length[scoords]}, {j, 1, 
              Length[dcoords]}]];\)\)

TextCoord[{sx_, sy_}, {dx_, dy_}] :=  {(sx + dx)/2, (sy + dy)/
          2}

\(\(TransportationArcs[supplycities_, 
          demandcities_] := 
\ \ Module[{s, d, scoords, dcoords, costs, 
            q}, 
\ \ \ \ s\  = 
            supplycities\  /. \ {city_String, state_, lat_, lon_, s_, d_} -> 
                s; 
\ \ \ \ d\  = 
            demandcities\  /. \ {city_String, state_, lat_, lon_, s_, d_} -> 
                d; 
\ \ \ \ scoords\  = 
            supplycities\  /. {city_String, state_, lat_, lon_, s_, 
                  d_} -> {lon, lat}; 
\ \ \ \ dcoords\  = \ 
            demandcities\  /. \ {city_String, state_, lat_, lon_, s_, 
                  d_} -> {lon, lat}; 
\ \ \ \ costs\  = \ 
            CalculateDistances[scoords, dcoords]; 
\ \ \ \ q\  = \ 
            TransportationProblem[costs, s, d]; 
\ \ \ Arcs[q, scoords, 
            dcoords]\ 
\ \ ];\)\)

shipments  =  
      TransportationArcs[supplycities, demandcities]

Output

g = 
        Show[borderpoly, shipments, supplypoints, demandpoints];

ExcelWrite[ExcelShape["Output", "Map"], g]