#!/usr/bin/perl open IN, "<".$ARGV[0] or die "Cannot open $1"; while (){ $linea++; chomp; if ($linea ==1){ if (/MAX/ || /max/ || /Max/){ $tipo = 1; } }else{ @lin = split / / ; $num=0; for $i (@lin){ $num++; $costes[$linea-1][$num] = $i; } $N = $num; } } close IN; if ($N != $linea-1) { die "Not a square matrix"; } print "$N\n"; for $i (1..$N) { for $j (1..$N) { print "$costes[$i][$j] "; } print "\n"; } for $i (1..$N){ for $j (1..$N){ if ($tipo==1){ $A[$i][$j]=-$costes[$i][$j]; }else{ $A[$i][$j]=$costes[$i][$j]; } } } # SUBROUTINE ASSCT ( N, A, C, T ) 10 # INTEGER A(130,131), C(130), CH(130), LC(130), LR(130), # * LZ(130), NZ(130), RH(131), SLC(130), SLR(130), # * U(131) # INTEGER H, Q, R, S, T # EQUIVALENCE (LZ,RH), (NZ,CH) # C # C THIS SUBROUTINE SOLVES THE SQUARE ASSIGNMENT PROBLEM # C THE MEANING OF THE INPUT PARAMETERS IS # C N = NUMBER OF ROWS AND COLUMNS OF THE COST MATRIX, WITH # C THE CURRENT DIMENSIONS THE MAXIMUM VALUE OF N IS 130 # C A(I,J) = ELEMENT IN ROW I AND COLUMN J OF THE COST MATRIX # C ( AT THE END OF COMPUTATION THE ELEMENTS OF A ARE CHANGED) # C THE MEANING OF THE OUTPUT PARAMETERS IS # C C(J) = ROW ASSIGNED TO COLUMN J (J=1,N) # C T = COST OF THE OPTIMAL ASSIGNMENT # C ALL PARAMETERS ARE INTEGER # C THE MEANING OF THE LOCAL VARIABLES IS # C A(I,J) = ELEMENT OF THE COST MATRIX IF A(I,J) IS POSITIVE, # C COLUMN OF THE UNASSIGNED ZERO FOLLOWING IN ROW I # C (I=1,N) THE UNASSIGNED ZERO OF COLUMN J (J=1,N) # C IF A(I,J) IS NOT POSITIVE # C A(I,N+1) = COLUMN OF THE FIRST UNASSIGNED ZERO OF ROW I # C (I=1,N) # C CH(I) = COLUMN OF THE NEXT UNEXPLORED AND UNASSIGNED ZERO # C OF ROW I (I=1,N) # C LC(J) = LABEL OF COLUMN J (J=1,N) # C LR(I) = LABEL OF ROW I (I=1,N) # C LZ(I) = COLUMN OF THE LAST UNASSIGNED ZERO OF ROW I(I=1,N) # C NZ(I) = COLUMN OF THE NEXT UNASSIGNED ZERO OF ROW I(I=1,N) # C RH(I) = UNEXPLORED ROW FOLLOWING THE UNEXPLORED ROW I # C (I=1,N) # C RH(N+1) = FIRST UNEXPLORED ROW # C SLC(K) = K-TH ELEMENT CONTAINED IN THE SET OF THE LABELLED # C COLUMNS # C SLR(K) = K-TH ELEMENT CONTAINED IN THE SET OF THE LABELLED # C ROWS # C U(I) = UNASSIGNED ROW FOLLOWING THE UNASSIGNED ROW I # C (I=1,N) # C U(N+1) = FIRST UNASSIGNED ROW # C # C THE VECTORS C,CH,LC,LR,LZ,NZ,SLC,SLR MUST BE DIMENSIONED # C AT LEAST AT (N), THE VECTORS RH,U AT LEAST AT (N+1), # C THE MATRIX A AT LEAST AT (N,N+1) # C # C INITIALIZATION $MAXNUM = 10**14; $NP1 = $N+1; for $j (1..$N){ $C[$J] = 0; $LZ[$J] = 0; $NZ[$J] = 0; $U[$J] = 0; } $U[$NP1] = 0; $T = 0; # C REDUCTION OF THE INITIAL COST MATRIX for $J (1..$N){ $S = $A[1][$J]; for $L (2 .. $N) { if ( $A[$L][$J] < $S ){ $S = $A[$L][$J]; } } $T += $S; for $I (1..$N){ $A[$I][$J] -= $S; } } for $I (1..$N){ $Q = $A[$I][1]; for $L (2..$N){ if ( $A[$I][$L] < $Q ) { $Q = $A[$I][$L]; } } $T += $Q; $L = $NP1; for $J (1..$N){ $A[$I][$J] -= $Q; next if ( $A[$I][$J] != 0 ); $A[$I][$L] = -$J; $L = $J; } } # C CHOICE OF THE INITIAL SOLUTION $K = $NP1; for $I (1..$N){ $LJ = $NP1; $J = -$A[$I][$NP1]; a80: if ( $C[$J] == 0 ) { goto b130; } $LJ = $J; $J = -$A[$I][$J]; if ( $J != 0 ) { goto a80; } $LJ = $NP1; $J = -$A[$I][$NP1]; c90: $R = $C[$J]; $LM = $LZ[$R]; $M = $NZ[$R]; while ( $M != 0 ) { if ( $C[$M] == 0 ) { goto d120; } $LM = $M; $M = -$A[$R][$M]; } e110: $LJ = $J; $J = -$A[$I][$J]; if ( $J != 0 ) { goto c90; } $U[$K] = $I; $K = $I; next; d120: $NZ[$R] = -$A[$R][$M]; $LZ[$R] = $J; $A[$R][$LM] = -$J; $A[$R][$J] = $A[$R][$M]; $A[$R][$M] = 0; $C[$M] = $R; b130: $C[$J] = $I; $A[$I][$LJ] = $A[$I][$J]; $NZ[$I] = -$A[$I][$J]; $LZ[$I] = $LJ; $A[$I][$J] = 0; } # C RESEARCH OF A NEW ASSIGNMENT res: ; if ( $U[$NP1] == 0 ){ &output(); exit; } for $I (1..$N){ $CH[$I] = 0; $LC[$I] = 0; $LR[$I] = 0; $RH[$I] = 0; } $RH[$NP1] = -1; $KSLC = 0; $KSLR = 1; $R = $U[$NP1]; $LR[$R] = -1; $SLR[1] = $R; if ( $A[$R][$NP1] != 0 ) { ERR170: $L = -$A[$R][$NP1]; if ( $A[$R][$L] == 0 || $RH[$R] != 0 ) { goto f180; } $RH[$R] = $RH[$NP1]; $CH[$R] = -$A[$R][$L]; $RH[$NP1] = $R; f180: if ( $LC[$L] == 0 ) { goto g200; } if ( $RH[$R] == 0 ) { goto h210; } i190: $L = $CH[$R]; $CH[$R] = -$A[$R][$L]; if ( $A[$R][$L] != 0 ) { goto f180; } $RH[$NP1] = $RH[$R]; $RH[$R] = 0; goto f180; g200: $LC[$L] = $R; if ( $C[$L] == 0 ) { goto z360; } $KSLC++; $SLC[$KSLC] = $L; $R = $C[$L]; $LR[$R] = $L; $KSLR++; $SLR[$KSLR] = $R; if ( $A[$R][$NP1] != 0 ) { goto ERR170; } h210: ; # CONTINUE if ( $RH[$NP1] > 0 ) { goto z350; } } # C REDUCTION OF THE CURRENT COST MATRIX z220: $H = $MAXNUM; for $J (1..$N){ next if ( $LC[$J] != 0 ); for $K (1..$KSLR) { $I = $SLR[$K]; if ( $A[$I][$J] < $H ) { $H = $A[$I][$J]; } } } $T += $H; for $J (1..$N) { next if ( $LC[$J] != 0 ); for $K (1 .. $KSLR) { $I = $SLR[$K]; $A[$I][$J] = $A[$I][$J]-$H; next if ( $A[$I][$J] != 0 ); if ( $RH[$I] == 0 ){ $RH[$I] = $RH[$NP1]; $CH[$I] = $J; $RH[$NP1] = $I; } $L = $NP1; z260: $NL = -$A[$I][$L]; if ( $NL == 0 ) { goto z270; } $L = $NL; goto z260; z270: $A[$I][$L] = -$J; } } if ( $KSLC != 0 ) { for $I (1..$N) { next if ( $LR[$I] != 0 ); for $K (1..$KSLC) { $J = $SLC[$K]; if ( $A[$I][$J] <= 0 ) { $L = $NP1; z300: $NL = - $A[$I][$L]; if ( $NL == $J ) { goto z310; } $L = $NL; goto z300; z310: $A[$I][$L] = $A[$I][$J]; $A[$I][$J] = $H; next; } $A[$I][$J] = $A[$I][$J]+$H; } } } z350: $R = $RH[$NP1]; goto i190; # C ASSIGNMENT OF A NEW ROW z360: $C[$L] = $R; $M = $NP1; z370: $NM = -$A[$R][$M]; if ( $NM == $L ) { goto z380; } $M = $NM; goto z370; z380: $A[$R][$M] = $A[$R][$L]; $A[$R][$L] = 0; if ( $LR[$R] >= 0 ) { $L = $LR[$R]; $A[$R][$L] = $A[$R][$NP1]; $A[$R][$NP1] = -$L; $R = $LC[$L]; goto z360; } z390: $U[$NP1] = $U[$R]; $U[$R] = 0; &output; goto res; exit ; sub output { # for $i (1..$N){ # for $j (1..$N){ # print "$A[$i][$j] "; # } # print "\n"; # } print "\nRows assigned to columns:\n@C\n"; $Z=0; for $i (1..$N){ $Z += $costes[$i][$C[$i]]; } print "Value of the objective function: $Z\n"; } __END__