# R/Constraints.R In mcplR: Multiple Cue Probability Learning in R

```setClass("Constraints",
contains="VIRTUAL"
)

setClass("Unconstrained",
contains="Constraints",
representation(
dim="integer"
)
)

setClass("BoxConstraints",
contains="Constraints",
representation(
min="numeric",
max="numeric"
)
)

setClass("LinearConstraints",
contains="Constraints",
representation(
Amat = "matrix",
bvec = "numeric"
)
)

setMethod("combineConstraints",signature(x="Unconstrained",y="Unconstrained"),
function(x,y) {
return(new("Unconstrained",
dim = x@dim+y@dim))
}
)

setMethod("combineConstraints",signature(x="Unconstrained",y="BoxConstraints"),
function(x,y) {
min <- c(rep(-Inf,x@dim),y@min)
max <- c(rep(Inf,x@dim),y@max)
return(new("BoxConstraints",
min=min,
max=max)
)
}
)

setMethod("combineConstraints",signature(x="BoxConstraints",y="Unconstrained"),
function(x,y) {
min <- c(x@min,rep(-Inf,y@dim))
max <- c(x@max,rep(Inf,y@dim))
return(new("BoxConstraints",
min=min,
max=max)
)
}
)

setMethod("combineConstraints",signature(x="Unconstrained",y="LinearConstraints"),
function(x,y) {
A <- cbind(matrix(0,ncol=x@dim,nrow=nrow(y@Amat)))
return(new("LinearConstraints",
Amat=A,
bvec=y@bvec)
)
}
)

setMethod("combineConstraints",signature(x="LinearConstraints",y="Unconstrained"),
function(x,y) {
A <- cbind(matrix(0,ncol=y@dim,nrow=nrow(x@Amat)))
return(new("LinearConstraints",
Amat=A,
bvec=x@bvec)
)
}
)

setMethod("combineConstraints",signature(x="BoxConstraints",y="BoxConstraints"),
function(x,y) {
min <- c(x@min,y@min)
max <- c(x@max,y@max)
return(new("BoxConstraints",
min=min,
max=max)
)
}
)

setMethod("combineConstraints",signature(x="BoxConstraints",y="LinearConstraints"),
function(x,y) {
min <- x@min
max <- x@max
npar <- length(min)
minMat <- matrix(0.0,ncol=npar,nrow=npar)
diag(minMat) <- as.numeric(min > -Inf)
maxMat <- matrix(0.0,ncol=npar,nrow=npar)
diag(maxMat) <- -as.numeric(max < Inf)
A1 <- rbind(minMat[rowSums(minMat) > 0,],maxMat[rowSums(maxMat) > 0,])
b1 <- c(min[min > -Inf],-max[max < Inf])
A2 <- y@Amat
b2 <- y@bvec
Amat <- bdiag(list(A1,A2))
bvec <- c(b1,b2)
return(new("LinearConstraints",
Amat=Amat,
bvec=bvec)
)
}
)

setMethod("combineConstraints",signature(x="LinearConstraints",y="BoxConstraints"),
function(x,y) {
min <- y@min
max <- y@max
npar <- length(min)
minMat <- matrix(0.0,ncol=npar,nrow=npar)
diag(minMat) <- as.numeric(min > -Inf)
maxMat <- matrix(0.0,ncol=npar,nrow=npar)
diag(maxMat) <- -as.numeric(max < Inf)
A2 <- rbind(minMat[rowSums(minMat) > 0,],maxMat[rowSums(maxMat) > 0,])
b2 <- c(min[min > -Inf],-max[max < Inf])
A1 <- x@Amat
b1 <- x@bvec
Amat <- bdiag(list(A1,A2))
bvec <- c(b1,b2)
return(new("LinearConstraints",
Amat=Amat,
bvec=bvec)
)
}
)

setMethod("combineConstraints",signature(x="LinearConstraints",y="LinearConstraints"),
function(x,y) {
Amat <- bdiag(list(x@Amat,y@Amat))
bvec <- c(x@bvec,y@bvec)
new("LinearConstraints",
Amat = Amat,
bvec=bvec)
}
)

# setMethod("getConstraints",signature(object="McplModel"),
#           function(object,...) {
#             lCon <- getConstraints([email protected])
#             rCon <- getConstraints([email protected])
#             if(is(lCon,"NoConstraints") & is(rCon,"NoConstraints")) return(new("NoConstraints"))
#             if(is(lCon,"LinearConstraints") | is(rCon,"LinearConstraints")) {
#               npar <- length(unlist(getPars([email protected])))
#               if(is(lCon,"LinearConstraints")) {
#                 A1 <- [email protected]
#                 b1 <- [email protected]
#               } else if(is(lCon,"BoxConstraints")) {
#                 # minimum first
#                 minMat <- matrix(0.0,ncol=npar,nrow=npar)
#                 diag(minMat) <- as.numeric([email protected] > -Inf)
#                 maxMat <- matrix(0.0,ncol=npar,nrow=npar)
#                 diag(maxMat) <- -as.numeric([email protected] < Inf)
#                 A1 <- rbind(minMat[rowSums(minMat) > 0,],maxMat[rowSums(maxMat) > 0,])
#                 b1 <- c([email protected][[email protected] > -Inf],[email protected][[email protected] < Inf])
#               } else if(is(lCon,"NoConstraints")) {
#                 A1 <- matrix(0,ncol=npar,nrow=0)
#                 b1 <- vector(,length=0)
#               }  else {
#                 stop("Cannot determine constraints")
#               }
#               npar <- length(unlist(getPars([email protected])))
#               if(is(rCon,"LinearConstraints")) {
#                 A2 <- [email protected]
#                 b2 <- [email protected]
#               } else if(is(rCon,"BoxConstraints")) {
#                 # minimum first
#                 minMat <- matrix(0.0,ncol=npar,nrow=npar)
#                 diag(minMat) <- as.numeric([email protected] > -Inf)
#                 maxMat <- matrix(0.0,ncol=npar,nrow=npar)
#                 diag(maxMat) <- -as.numeric([email protected] < Inf)
#                 A2 <- rbind(minMat[rowSums(minMat) > 0,],maxMat[rowSums(maxMat) > 0,])
#                 b2 <- c([email protected][[email protected] > -Inf],[email protected][[email protected] < Inf])
#               } else if(is(rCon,"NoConstraints")) {
#                 A2 <- matrix(0,ncol=npar,nrow=0)
#                 b2 <- vector(,length=0)
#               }  else {
#                 stop("Cannot determine constraints")
#               }
#               Amat <- bdiag(list(A1,A2))
#               bvec <- c(b1,b2)
#               return(new("LinearConstraints",
#                          Amat = Amat,
#                          bvec = bvec)
#               )
#             } else if(is(lCon,"BoxConstraints") | is(rCon,"BoxConstraints")) {
#               # no linear constraints, so can just use box constraints if necessary
#               npar <- length(unlist(getPars([email protected])))
#               if(is(lCon,"BoxConstraints")) {
#                 # minimum first
#                 min1 <- [email protected]
#                 max1 <- [email protected]
#               } else if(is(lCon,"NoConstraints")){
#                 min1 <- rep(-Inf,npar)
#                 max1 <- rep(Inf,npar)
#               } else {
#                 stop("Cannot determine constraints")
#               }
#               npar <- length(unlist(getPars([email protected])))
#               if(is(rCon,"BoxConstraints")) {
#                 # minimum first
#                 min2 <- [email protected]
#                 max2 <- [email protected]
#               } else if(is(rCon,"NoConstraints")){
#                 min2 <- rep(-Inf,npar)
#                 max2 <- rep(Inf,npar)
#               } else {
#                 stop("Cannot determine constraints")
#               }
#             }
#           }
# )
```

## Try the mcplR package in your browser

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

mcplR documentation built on May 31, 2017, 1:49 a.m.