'********************************************************* '* APPOINTMENT METHOD * '* ------------------ * '* * '* LIST OF MAIN VARIABLES: * '* * '* NP: NUMBER OF JOBS * '* C(NP,NP): APPOINTMENT COST MATRIX * '* M(NP,NP): JOB/APPLICANT MATRIX * '* IF1: FLAG=1 IF OPTIMAL APPOINTMENT IS FOUND * '* IZ: FLAG TO MARK A ZERO * '* XMIN: MINIMUM VALUE * '* XCASE: APPOINTMENT OF A ZERO IN RELATION WITH * '* THE ZEROES' MINIMUM * '* NZ: NUMBER OF ZEROES * '* ZI,ZJ: COORDINATES OF CURRENT CASE * '* M,N: COORDINATES OF A MARKED ZERO * '* A,B: AUXILIARY VARIABLES TO CHANGE * '* APPOINTMENTS. * '* ----------------------------------------------------- * '* PROBLEM DESCRIPTION * '* An employer receives four applicants for four avail- * '* able jobs. They must give a mark from 1 to 100 to * '* each job (1=very poor preference, 100=very good). * '* See table below: * '* J O B S * '* J1 J2 J3 J4 * '* A1 90 80 20 40 * '* APPLICANTS A2 90 70 30 80 * '* A3 40 70 20 80 * '* A4 50 40 20 60 * '* The employer's purpose is to appoint the four jobs so * '* as to maximize the applicants' satisfaction. * '* ----------------------------------------------------- * '* SAMPLE RUN: * '* (appoint four jobs with the following regrets matrix: * '* J O B S * '* J1 J2 J3 J4 * '* A1 10 20 80 60 * '* APPLICANTS A2 10 30 70 20 * '* A3 60 30 80 20 * '* A4 50 60 80 40 ) * '* * '* LINEAR PROGRAMMING * '* * '* APPOINTMENT METHOD * '* * '* NUMBER OF JOBS ? 4 * '* * '* INPUT APPOINTMENT COSTS/REGRETS OF APPLICANTS: * '* * '* APPLICANT #1: * '* JOB #1 ? 10 * '* JOB #2 ? 20 * '* JOB #3 ? 80 * '* JOB #4 ? 60 * '* * '* APPLICANT #2: * '* JOB #1 ? 10 * '* JOB #2 ? 30 * '* JOB #3 ? 70 * '* JOB #4 ? 20 * '* * '* APPLICANT #3: * '* JOB #1 ? 60 * '* JOB #2 ? 30 * '* JOB #3 ? 80 * '* JOB #4 ? 20 * '* * '* APPLICANT #4: * '* JOB #1 ? 50 * '* JOB #2 ? 60 * '* JOB #3 ? 80 * '* JOB #4 ? 40 * '* * '* APPOINTMENTS: * '* * '* APPLICANT #1 => JOB #2 * '* APPLICANT #2 => JOB #1 * '* APPLICANT #3 => JOB #4 * '* APPLICANT #4 => JOB #3 * '* * '* ----------------------------------------------------- * '* REFERENCE: * '* Modeles pratiques de decision Tome 2, By Jean-Pierre * '* Blanger, PSI Editions, France, 1982. * '********************************************************* OPTION BASE 0 DEFINT I-N 'PROGRAM APPOINTMENT CLS GOSUB 2000 'INPUT COST/APPOINT GOSUB 3000 'HUNGARIAN ALGORITHM GOSUB 8000 'PRINT RESULTS END 2000 'INPUT COST/APPOINT PRINT PRINT " LINEAR PROGRAMMING" PRINT PRINT " APPOINTMENT METHOD" PRINT INPUT " NUMBER OF JOBS "; NP DIM CP(NP, NP), M(NP, NP) PRINT PRINT " INPUT APPOINTMENT COSTS/REGRETS OF APPLICANTS:" FOR I = 1 TO NP PRINT PRINT " APPLICANT #"; I; ":" FOR J = 1 TO NP PRINT " JOB #"; J; INPUT " "; C(I, J) NEXT J NEXT I PRINT PRINT " APPOINTMENTS:" PRINT RETURN 3000 'HUNGARIAN ALGORITHM 3010 GOSUB 4000 'ZEROES GOSUB 5000 'APPOINT GOSUB 6000 'MARK GOSUB 7000 'SUB-ADD GOSUB 5000 'APPOINT IF IF1 <> NP THEN GOTO 3010 RETURN 4000 'ZEROES IZ = 0: R = 0 FOR I = 1 TO NP XMIN = C(I, 1) FOR J = 1 TO NP IF C(I, J) = 0 THEN IZ = 1 IF C(I, J) < XMIN THEN XMIN = C(I, J) NEXT J IF IZ = 1 THEN IZ = 0: GOTO 4100 END IF FOR J = 1 TO NP C(I, J) = C(I, J) - XMIN NEXT J 4100 NEXT I FOR J = 1 TO NP XMIN = C(1, J) FOR I = 1 TO NP IF C(I, J) = 0 THEN IZ = 1 IF C(I, J) < XMIN THEN XMIN = C(I, J) NEXT I IF IZ = 1 THEN IZ = 0: GOTO 4200 END IF FOR I = 1 TO NP C(I, J) = C(I, J) - XMIN NEXT I 4200 NEXT J RETURN 5000 'APPOINT FOR I = 1 TO NP FOR J = 1 TO NP M(I, J) = 0: C(0, J) = 0 NEXT J C(I, 0) = 0 NEXT I FOR I = 1 TO NP XCASE = 999999 FOR J = 1 TO NP IF C(I, J) <> 0 OR M(I, J) <> 0 THEN GOTO 5140 NZ = 0 FOR K = 1 TO NP IF C(K, J) = 0 THEN NZ = NZ + 1 NEXT K IF NZ < XCASE THEN XCASE = NZ: ZI = I: ZJ = J END IF 5140 NEXT J M(ZI, ZJ) = 1 FOR K = 1 TO NP IF C(K, ZJ) = 0 AND M(K, ZJ) = 0 THEN M(K, ZJ) = -1 NEXT K FOR K = 1 TO NP IF C(ZI, K) = 0 AND M(ZI, K) = 0 THEN M(ZI, K) = -1 NEXT K NEXT I IF1 = 0 FOR I = 1 TO NP FOR J = 1 TO NP IF M(I, J) = 1 THEN IF1 = IF1 + 1 NEXT J NEXT I RETURN 6000 'MARK 6010 FOR I = 1 TO NP N = 0 FOR J = 1 TO NP IF M(I, J) = 1 THEN N = 1 NEXT J IF N = 0 AND C(I, 0) = 0 THEN C(I, 0) = 1: M = 1 END IF NEXT I FOR J = 1 TO NP FOR I = 1 TO NP IF M(I, J) = -1 AND C(I, 0) = 1 AND C(0, J) = 0 THEN C(0, J) = 1: M = 1 END IF NEXT I NEXT J FOR I = 1 TO NP FOR J = 1 TO NP IF M(I, J) = 1 AND C(0, J) = 1 AND C(I, 0) = 0 THEN C(I, 0) = 1: M = 1 END IF NEXT J NEXT I IF M = 1 THEN M = 0: GOTO 6010 END IF RETURN 7000 'SUB-ADD XMIN = 999999 FOR I = 1 TO NP FOR J = 1 TO NP A = C(I, 0): B = C(0, J) IF A = 1 AND B = 0 AND C(I, J) < XMIN THEN XMIN = C(I, J) NEXT J NEXT I FOR I = 1 TO NP FOR J = 1 TO NP A = C(I, 0): B = C(0, J) IF A = 1 AND B = 0 THEN C(I, J) = C(I, J) - XMIN IF A = 0 AND B = 1 THEN C(I, J) = C(I, J) + 2 * XMIN NEXT J NEXT I RETURN 8000 'PRINT RESULTS FOR I = 1 TO NP FOR J = 1 TO NP IF M(I, J) <> 1 THEN GOTO 8050 PRINT " APPLICANT #"; I; " => JOB #"; J 8050 NEXT J NEXT I PRINT RETURN 'END OF FILE APPOINT.BAS