home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Education Sampler 1992 [NeXTSTEP]
/
Education_1992_Sampler.iso
/
Mathematics
/
Notebooks
/
OperationsResearch
/
hungarian.m
< prev
next >
Wrap
Text File
|
1991-11-11
|
4KB
|
94 lines
Initialization/:
Initialization :=
Block[{}, k =. ; v =. ; g =. ; h =. ; i = 1; j = 1;
Clear[cost, rowMin, rowRed, colMin, colRed, rowCheck, colCheck];
Print[INITIALIZATION, " ", DONE]]
InputPhase/: InputPhase :=
Block[{}, n = Input["What is the square matrix order?"];
Do[cost[xx, yy] =
Input["Enter row by row,one \
element at a time"], {xx, n}, {yy, n}];
costMatrix = Table[cost[y, z], {y, n}, {z, n}];
Print[TableForm[costMatrix]]]
RowReduction/: RowReduction :=
Block[{}, Clear[rowMin, rowRed];
Do[rowMin[k] = Min[costMatrix[[k]]], {k, 1, n}];
Do[rowRed[k] = costMatrix[[k]] - rowMin[k], {k, 1, n}];
rowReducedMatrix = Table[rowRed[k], {k, n}];
Print[TableForm[rowReducedMatrix]]]
ColumnReduction/:
ColumnReduction :=
Block[{}, Clear[colMin, colRed]; p = Transpose[rowReducedMatrix];
Do[colMin[k] = Min[p[[k]]], {k, 1, n}];
Do[colRed[k] = p[[k]] - colMin[k], {k, 1, n}];
q = Table[colRed[k], {k, n}]; colReducedMatrix = Transpose[q];
Print[TableForm[colReducedMatrix]]]
ZeroCheck/: ZeroCheck :=
Block[{}, Clear[rowCheck, colCheck]; v =. ; k =. ; g =. ; h =. ; i = 1;
j = 1; Do[If[colReducedMatrix[[k,v]] == 0,
rowCheck[i] = k; colCheck[j] = v; Print[k, v]; i++; j++], {k, n},
{v, n}]; zeroRows = Table[rowCheck[g], {g, 1, i - 1}];
zeroCols = Table[colCheck[h], {h, i - 1}]; Null]
Branching/: Branching :=
If[Length[zeroRows] >= n, Print[POSSIBLE, " ", OPTIMUM, " ", goto, " ",
OPTIMAL, " ", function], Print[NOT, " ", OPTIMUM, " ", YET, " ", goto,
" ", NONOPTIMAL, " ", function]]
Assignment/: Assignment :=
Block[{l1, l2, s, x = {}, y = {}},
If[loop != 0, t = Append[t, e[[loop]]]; u = Append[u, f[[loop]]];
l1 = Length[e]; x = {}; y = {}; x = e; y = f;
Do[If[First[x] == Last[t],
e = Drop[e, {1, 1}]; x = RotateLeft[x]; f = Drop[f, {1, 1}];
y = RotateLeft[y], x = RotateLeft[x]; y = RotateLeft[y];
e = RotateLeft[e]; f = RotateLeft[f]], {s, l1}]; x = {}; y = {};
x = e; y = f; l2 = Length[e];
Do[If[First[y] == Last[u],
f = Drop[f, {1, 1}]; y = RotateLeft[y]; e = Drop[e, {1, 1}];
x = RotateLeft[x], y = RotateLeft[y]; x = RotateLeft[x];
f = RotateLeft[f]; e = RotateLeft[e]], {s, l2}]];
If[Length[e] == 0, loop = 0, loop = 1]]
Optimal/: Optimal :=
Block[{solution, l, r}, l = Length[zeroRows]; objective = 0;
For[i = 1, i <= l, i++, t = {}; u = {}; tu = {}; e = {}; f = {};
e = zeroRows; f = zeroCols; loop = i; Do[Assignment, {solution, n}];
tu = Intersection[t, u];
If[Length[tu] == n, Print[OPTIMAL];
Do[Print[t[[r]], u[[r]]]; objective += costMatrix[[t[[r]],u[[r]]]],
{r, n}]; Print[OBJECTIVE, " ", COST, " ", IS, " ", objective];
Break[]]]; If[i == l + 1,
Print[NONOPTIMAL, " ", still, " ", go, " ", to, " ", Nonoptimal]]]
NonOptimal/: NonOptimal :=
Block[{z, rows = {}, cols = {}, uncovered = {}, common = {}, iteru, iterc,
q2 = {}}, z = n; q2 = colReducedMatrix; timen = 1; timen++;
While[z != 0, For[row = 1, row <= n, row++,
If[FreeQ[rows, row], If[Count[q2[[row]], 0] == z,
rows = Append[rows, row]; q2[[row]] = q2[[row]] + 1]]];
q2 = Transpose[q2]; For[col = 1, col <= n, col++,
If[FreeQ[cols, col], If[Count[q2[[col]], 0] == z,
cols = Append[cols, col]; q2[[col]] = q2[[col]] + 1]]];
q2 = Transpose[q2]; z--];
For[row = 1, row <= n, row++,
For[col = 1, col <= n, col++,
If[FreeQ[rows, row] && FreeQ[cols, col],
uncovered = Append[uncovered, colReducedMatrix[[row,col]]]];
If[MemberQ[rows, row] && MemberQ[cols, col],
common = Append[common, colReducedMatrix[[row,col]]]]]];
minuncov = Min[uncovered]; iteru = 1; iterc = 1;
For[row = 1, row <= n, row++,
For[col = 1, col <= n, col++,
If[FreeQ[rows, row] && FreeQ[cols, col] && iteru <= Length[uncovered],
colReducedMatrix[[row,col]] = uncovered[[iteru]] - minuncov; iteru++]
; If[MemberQ[rows, row] && MemberQ[cols, col] &&
iterc <= Length[common],
colReducedMatrix[[row,col]] = common[[iterc]] + minuncov; iterc++]]]\
; TableForm[colReducedMatrix]]