# R/readMps.R In linprog: Linear Programming / Optimization

```readMps <- function( file, solve=FALSE, maximum=FALSE ) {

i <- 1

## Name
while( substr( mps[i], 1, 4 ) != "NAME" & i < length(mps) ) {
i <- i + 1
}
if( substr( mps[i], 1, 4 ) == "NAME" ) {
name <- substr( mps[i], 15, nchar( mps[i] ) )
} else {
stop( "MPS file must have a line starting with 'NAME'" )
}

## Rows / Constraints
while( substr( mps[i], 1, 4 ) != "ROWS" & i < length(mps) ) {
i <- i + 1
}
if( substr( mps[i], 1, 4 ) != "ROWS" ) stop( "MPS file must have a line starting with 'ROWS'" )

objname <- NULL
bvec <- NULL   # constraints
svec <- NULL   # sign of the constraints

i <- i + 1
while( substr( mps[i], 1, 7 ) != "COLUMNS" & i < length(mps)) {
sign <- substr( mps[i], 2,2 )
if( sign == "E" ) stop("Equaltity constraints are not implemented yet.")
if( !( sign %in% c("E", "L", "G", "N" ) ) ) {
sign <- substr( mps[i], 3,3 )
}
if( sign %in% c("E", "L", "G" ) ) {
rname <- strsplit( mps[i], " " )[[1]][length( strsplit( mps[i], " " )[[1]] )]
bvec <- c( bvec, 0 )
svec <- c( svec, sign )
names(bvec)[length( bvec ) ]  <-  rname
names(svec)[length( svec ) ]  <-  rname
} else {
if( sign == "N" ) {
if( is.null( objname ) ) {
objname <- strsplit( mps[i], " " )[[1]][length( strsplit( mps[i], " " )[[1]] )]
}
} else {
stop("the 2nd or 3rd column of the rows section must be 'N', 'E', 'L' or 'G'")
}
}
i <- i + 1
}

## Columns
if( substr( mps[i], 1, 7 ) != "COLUMNS" )
stop( "MPS file must have a line starting with 'COLUMS'" )
cvec <- NULL
Amat <- matrix(0, length(bvec), 0 )
rownames(Amat) <- names(bvec)
i <- i + 1
while( substr( mps[i], 1, 3 ) != "RHS" & i < length(mps)) {
temp <- strsplit( mps[i], " " )[[1]]
temp <- temp[ temp != "" ]
if( !(temp[1] %in% colnames(Amat) ) ) {
cvec <- c( cvec, 0 )
Amat <- cbind( Amat, rep( 0, nrow(Amat) ) )
names(cvec)[length(cvec)]  <- temp[1]
colnames(Amat)[ncol(Amat)] <- temp[1]
}
for( j in 1:((length(temp)-1)/2) ) {
if( temp[ 2*j ] == objname ) {
cvec[ temp[ 1 ] ] <- as.numeric( temp[ 2*j + 1 ] )
} else {
if( temp[ 2*j ] %in% names(bvec) ) {
Amat[ temp[ 2*j ], temp[ 1 ] ] <- as.numeric( temp[ 2*j + 1 ] )
} else {
stop( paste( "Constraint name '",temp[ 2*j ],"' is not defined", sep="") )
}
}
}
i <- i + 1
}

## Restriction values
if( substr( mps[i], 1, 3 ) != "RHS" ) stop( "MPS file must have a line starting with 'RHS'" )
i <- i + 1
while( substr( mps[i], 1, 6 ) != "BOUNDS" & substr( mps[i], 1, 6 ) != "ENDATA" & i < length(mps)) {
temp <- strsplit( mps[i], " " )[[1]]
temp <- temp[ temp != "" ]
for( j in 1:((length(temp)-1)/2) ) {
if( temp[ 2*j ] %in% names(bvec) ) {
bvec[ temp[ 2*j ] ] <- as.numeric( temp[ 2*j + 1 ] )
} else {
stop( paste( "Constraint name '",temp[ 2*j ],"' is not defined", sep="") )
}
}
i <- i + 1
}

## Bounds
if( substr( mps[i], 1, 6 ) == "BOUNDS" ) {
i <- i + 1
while( substr( mps[i], 1, 6 ) != "ENDATA" & i <= length(mps)) {
temp <- strsplit( mps[i], " " )[[1]]
temp <- temp[ temp != "" ]
if( temp[ 3 ] %in% colnames(Amat) ) {
if(temp[1] == "UP") {
svec <- c( svec, "L" )
bvec <- c( bvec, as.numeric(temp[ 4 ]) )
Amat <- rbind( Amat, rep( 0, ncol(Amat) ) )
Amat[ nrow(Amat), temp[3] ] <- 1
names( svec )[length(svec)] <- paste(temp[1], temp[3], sep="" )
names( bvec )[length(bvec)] <- paste(temp[1], temp[3], sep="" )
rownames( Amat )[nrow(Amat)] <- paste(temp[1], temp[3], sep="" )
} else {
if( temp[1] %in% c("LO","FX","FR") ) {
stop("'LO', 'FX', and 'FR' Bounds are not implemented yet")
} else {
stop(" A 'BOUND' line must start with 'UP', 'LO', 'FX' or 'FR'")
}
}
} else {
stop( paste( "Variable name '",temp[ 3 ],"' is not defined", sep="") )
}
i <- i + 1
}
}

if( substr( mps[i], 1, 6 ) != "ENDATA" )
stop( "MPS file must have a line starting with 'ENDDATA'" )

## Changing 'Greater' constraints to 'Lower' constraints
for( j in 1:length(svec) ) {
if(svec[j] == "G" ) {
bvec[ j ]  <- - bvec[ j ]
Amat[ j, ] <- - Amat[ j, ]
}
}

res <- NULL
if(solve) {
res <- solveLP(cvec,bvec,Amat,maximum)
}

result <- list( name=name, cvec=cvec, bvec=bvec, Amat=Amat, res=res )
return( result )
}
```

## Try the linprog package in your browser

Any scripts or data that you put into this service are public.

linprog documentation built on May 1, 2019, 6:47 p.m.