lp generator

lp_generator.f90 — Fortran source code, 6 kB (7.129 bytes)

Dateiinhalt

PROGRAM Problem_Generator

  IMPLICIT NONE
  INTEGER           :: msec, nn, time_info(8)
  INTEGER,PARAMETER :: NMAX=99,MMAX=99
  INTEGER           :: I,J,N,M,CTYPE
  INTEGER           :: A(MMAX,NMAX),B(MMAX),C(NMAX)
  DOUBLEPRECISION   :: PERT
  REAL              :: VAL(1),MAXRANGE
  CHARACTER(100)    :: CHO,CHC,CHX,CHXG
  CHARACTER         :: LPTYPE,SGN
  CHARACTER(4)      :: CON,VARTYP
!
! Get all 8 integer fields off the date/time function:
!   time_info(7) = seconds of the minute (range 0 to 60)
!   time_info(8) = milliseconds of the second (range 0 to 999)
!
  CALL DATE_AND_TIME( VALUES = time_info )
  msec = 1000 * time_info(7) + time_info(8)                 ! a somewhat random integer
  CALL RANDOM_SEED( SIZE = nn )                             ! get the number of integers used for the seed
  CALL RANDOM_SEED( PUT = (/ ( i * msec, i = 1, nn ) /) )   ! give a proper seed
  CALL RANDOM_NUMBER( VAL )                                 ! generate a sequence of 1 pseudo-random number
!
! INPUT DATA
  WRITE(*,*) 'This program generates a random linear program with integer coefficients'
  WRITE(*,*)
  WRITE(*,*) 'What type of constraints would you like to have?'
  WRITE(*,*) '(s) standard'
  WRITE(*,*) '(c) canonical'
  WRITE(*,*) '(g) general'  
  WRITE(*,*)
  WRITE(*,*) 'Note: standard form assumes m<=n; full rank conditions may not hold'
  WRITE(*,*) 'Note: general form may include free variables'
  READ(*,*) LPTYPE
  IF (LPTYPE/='s'.AND.LPTYPE/='S'.AND.LPTYPE/='c'.AND.LPTYPE/='C'.AND.LPTYPE/='g'.AND. LPTYPE/='G') THEN  
     WRITE(*,*) 'Choice not valid!'
     STOP
  ENDIF
  WRITE(*,*)
  WRITE(*,*) 'Number of variables (1<=n<=99):'
  READ(*,*) N
  IF (N<1 .OR. N>NMAX) THEN 
     WRITE(*,*) 'Wrong dimension!'
     STOP
  ENDIF
  WRITE(*,*)
  WRITE(*,*) 'Number of constraints (1<=m<=99):'
  READ(*,*) M
  IF (M<1 .OR. M>MMAX .OR. ((LPTYPE=='s'.OR.LPTYPE=='S').AND.M>N)) THEN 
     WRITE(*,*) 'Wrong dimension!'
     STOP
  ENDIF
  WRITE(*,*) 'The coefficients in the LP will be randomly generated integers'
  WRITE(*,*) 'in the range [-MAXRANGE,MAXRANGE].'
  WRITE(*,*) 
  WRITE(*,*) 'Enter the maximum value MAXRANGE:'
  READ(*,*) MAXRANGE
  MAXRANGE=ABS(MAXRANGE)
!
! OUTPUT TO FILE
  WRITE(*,*) 
  WRITE(*,*) 'The output can be found in the file "lpout.txt"'      
  OPEN(UNIT=1,FILE='lpout.txt',STATUS='UNKNOWN')
  IF (LPTYPE=='s'.OR.LPTYPE=='S') WRITE(1,*) 'LP type: standard'
  IF (LPTYPE=='c'.OR.LPTYPE=='C') WRITE(1,*) 'LP type: canonical'
  IF (LPTYPE=='g'.OR.LPTYPE=='G') WRITE(1,*) 'LP type: general'
  WRITE(1,*) 'Number of variables:   ',N
  WRITE(1,*) 'Number of constraints: ',M
  WRITE(1,*)
  WRITE(1,*) 'Linear Program'
  WRITE(1,*) '=============='
  WRITE(1,*)
  
  CALL RANDOM_NUMBER( VAL )
  IF (VAL(1).GE.0.5) THEN 
     WRITE(1,*) 'Minimise'
  ELSE
     WRITE(1,*) 'Maximise'
  ENDIF
  WRITE(1,*)
! OBJECTIVE
  DO I=1,N
     CALL RANDOM_NUMBER( VAL )
     C(I)=NINT(MAXRANGE*(VAL(1)-0.5))
  END DO
! VECTOR B
  DO I=1,M
     CALL RANDOM_NUMBER( VAL )
     B(I)=NINT(MAXRANGE*(VAL(1)-0.5))
  END DO
! MATRIX
  DO I=1,M
    DO J=1,N
      CALL RANDOM_NUMBER( VAL )
      A(I,J)=NINT(MAXRANGE*(VAL(1)-0.5))
    END DO
  END DO
  IF (N<10) THEN 
     WRITE(CHO,*) '(I6,1X,A4,I1,A2,',N-1,'(A1,A1,I6,1X,A4,I1,A2))'
     WRITE(CHC,*) '(I6,1X,A4,I1,A2,',N-1,'(A1,A1,I6,1X,A4,I1,A2),A4,I6)'
     WRITE(CHX,*) '(1X,',N-1,'(A2,I1,A6),A2,I1,A4)'
     WRITE(CHXG,*) '(1X,',N-1,'(A2,I1,A2,A4,A2),A2,I1,A2,A4)'
  ELSEIF (N<100) THEN 
     WRITE(CHO,*) '(I6,1X,A4,I1,A2,',8,'(A1,A1,I6,1X,A4,I1,A2),',N-9,'(A1,A1,I6,1X,A4,I2,A2))'
     WRITE(CHC,*) '(I6,1X,A4,I1,A2,',8,'(A1,A1,I6,1X,A4,I1,A2),',N-9,'(A1,A1,I6,1X,A4,I2,A2),A4,I6)'
     WRITE(CHX,*) '(1X,',9,'(A2,I1,A6),',N-10,'(A2,I2,A6),A2,I2,A4)'
     WRITE(CHXG,*) '(1X,',9,'(A2,I1,A2,A4,A2),',N-10,'(A2,I2,A2,A4,A2),A2,I2,A2,A4)'
     IF (N==10) THEN 
        WRITE(CHX,*)  '(1X,',9,'(A2,I1,A6),A2,I2,A4)'
        WRITE(CHXG,*) '(1X,',9,'(A2,I1,A2,A4,A2),A2,I2,A2,A4)'
     ENDIF
  ENDIF
  IF (LPTYPE=='s'.OR.LPTYPE=='S') THEN 
! STANDARD CONSTRAINTS
     WRITE(1,CHO) C(1),'* X(',1,') ',(SGN(C(I)),' ',ABS(C(I)),'* X(',I,') ',I=2,MIN(N,9)),(SGN(C(I)),' ',ABS(C(I)),'* X(',I,') ',I=10,N)
     WRITE(1,*)
     WRITE(1,*) 'subject to'
     WRITE(1,*)
     DO J=1,M
        WRITE(1,CHC) A(J,1),'* X(',1,') ',(SGN(A(J,I)),' ',ABS(A(J,I)),'* X(',I,') ',I=2,MIN(N,9)),(SGN(A(J,I)),' ',ABS(A(J,I)),'* X(',I,') ',I=10,N),' = ',B(J)
     END DO
     WRITE(1,*)
     WRITE(1,CHX) ('X(',I,')>=0, ',I=1,MIN(N-1,9)),('X(',I,')>=0, ',I=10,N-1),'X(',N,')>=0' 
   ELSEIF (LPTYPE.EQ.'c'.OR.LPTYPE.EQ.'C') THEN 
!  CANONICAL CONSTRAINTS
     WRITE(1,CHO) C(1),'* X(',1,') ',(SGN(C(I)),' ',ABS(C(I)),'* X(',I,') ',I=2,MIN(N,9)),(SGN(C(I)),' ',ABS(C(I)),'* X(',I,') ',I=10,N)
     WRITE(1,*)
     WRITE(1,*) 'subject to'
     WRITE(1,*)
     DO J=1,M
        WRITE(1,CHC) A(J,1),'* X(',1,') ',(SGN(A(J,I)),' ',ABS(A(J,I)),'* X(',I,') ',I=2,MIN(N,9)),(SGN(A(J,I)),' ',ABS(A(J,I)),'* X(',I,') ',I=10,N),' <= ',B(J)
     END DO
     WRITE(1,*)
     WRITE(1,CHX) ('X(',I,')>=0, ',I=1,MIN(N-1,9)),('X(',I,')>=0, ',I=10,N-1),'X(',N,')>=0' 
   ELSEIF (LPTYPE.EQ.'g'.OR.LPTYPE.EQ.'G') THEN 
!    GENERAL CONSTRAINTS
     WRITE(1,CHO) C(1),'* X(',1,') ',(SGN(C(I)),' ',ABS(C(I)),'* X(',I,') ',I=2,MIN(N,9)),(SGN(C(I)),' ',ABS(C(I)),'* X(',I,') ',I=10,N)
     WRITE(1,*)
     WRITE(1,*) 'subject to'
     WRITE(1,*)
     DO J=1,M
        CALL RANDOM_NUMBER( VAL )
        CTYPE = NINT(2.9*VAL(1)-1.45)
        WRITE(1,CHC) A(J,1),'* X(',1,') ',(SGN(A(J,I)),' ',ABS(A(J,I)),'* X(',I,') ',I=2,MIN(N,9)),(SGN(A(J,I)),' ',ABS(A(J,I)),'* X(',I,') ',I=10,N),CON(CTYPE),B(J)
     END DO
     WRITE(1,*)             
     WRITE(1,CHXG) ('X(',I,') ',VARTYP(),', ',I=1,MIN(N-1,9)),('X(',I,')',VARTYP(),', ',I=10,N-1),'X(',N,') ',VARTYP() 
   ENDIF
   WRITE(1,*)
   WRITE(1,*) 'With the LP you can do the following:' 
   WRITE(1,*) '- transform it into standard or canonical form'
   WRITE(1,*) '- try to solve it graphically (for n=2)'           
   WRITE(1,*) '- check for feasibility (auxiliary LP)'
   WRITE(1,*) ' -try to compute (feasible) basic solutions'
   WRITE(1,*) '- try to solve it by the simplex method'
   WRITE(1,*) '- try to solve it by the revised simplex method'
   WRITE(1,*) '- try to compute a dual solution'
   WRITE(1,*) '- try to solve it by the dual simplex method'
   WRITE(1,*) '- compute shadow prices'
   CLOSE(UNIT=1)
   WRITE(*,*)
   WRITE(*,*) 'Press button to terminate!'
   READ(*,*)
END PROGRAM Problem_Generator


CHARACTER FUNCTION SGN(I)
IMPLICIT NONE
INTEGER, INTENT(IN) :: I
CHARACTER           :: CH
CH='+'
IF (I<0) CH='-'
SGN=CH
RETURN
END FUNCTION SGN

CHARACTER(4) FUNCTION CON(I)
IMPLICIT NONE
INTEGER, INTENT(IN) :: I
CHARACTER(4)        :: CH
IF (I<0)  CH=' <= '
IF (I>0)  CH=' >= '
IF (I==0) CH='  = '
CON=CH
RETURN
END FUNCTION CON

CHARACTER(4) FUNCTION VARTYP()
IMPLICIT NONE
INTEGER         :: CTYPE
CHARACTER(4)    :: CH
REAL            :: VAL(1)
CALL RANDOM_NUMBER( VAL ) 
CTYPE = NINT(2.9*VAL(1)-1.45)           
IF (CTYPE<0) CH='<= 0'
IF (CTYPE>0) CH='>= 0'
IF (CTYPE==0) CH='FREE'
VARTYP=CH
RETURN
END FUNCTION VARTYP