Проблемы при использовании optFederov из пакета AlgDesign - PullRequest
0 голосов
/ 08 октября 2019

У меня есть некоторые проблемы с использованием пакета AlgDesign. Я хочу создать дизайн, используя алгоритм обмена federov. К сожалению, я сталкиваюсь с ошибкой:

Error in apply(data[, numericColumn], 2, mean) : 
  dim(X) must have a positive length

Ошибка возникает при использовании различных порядков переменных сетки

cand.list = expand.grid(x1 = scale(as.data.frame(c(0, 0.1, 0.2, 0.3, 0.4, 0.5)), center = 0.0, scale = 0.5),
                        x2 = c("PMX", "MOC","OC","OX2","POS","CX","UX"),
                        x4 = c("Swap","Invert","Memetic 2-opt","Memetic k-opt","Memetic VNS"),
                        x5 = c("A","B")
)
federovDesign<-optFederov(~x1*x2*x5*x4,data = cand.list,nullify = 1,nRepeats = 40,center=TRUE)

Этот код вызывает ошибку, указанную выше. Если я использую следующий код, все работает нормально.

cand.list = expand.grid(x1 = scale(as.data.frame(c(0, 0.1, 0.2, 0.3, 0.4, 0.5)), center = 0.0, scale = 0.5),
                        x2 = c("PMX", "MOC","OC","OX2","POS","CX","UX"),
                        x3 = c(50, 100,150,200),
                        x4 = c("Swap","Invert","Memetic 2-opt","Memetic k-opt","Memetic VNS"),
                        x5 = c("A","B")
)
federovDesign<-optFederov(~x1*x2*x5*x4,data = cand.list,nullify = 1,nRepeats = 40,center=TRUE)

Я просто добавил еще одну переменную. Тем не менее, другие переменные остаются неизменными, но ошибка исчезает. Я наблюдаю это странное поведение каждый раз, когда использую пакет. Если повезет, я смогу заставить его работать, пробуя различные переменные порядки в моей сетке, однако я не понимаю основополагающей концепции. Я посмотрел на исходный код функции на github https://github.com/jvbraun/AlgDesign/blob/master/R/FederovOpt.R и попробовал свой первый cand.list, но ошибки не было:

cand.list = expand.grid(x1 = scale(as.data.frame(c(0, 0.1, 0.2, 0.3, 0.4, 0.5)), center = 0.0, scale = 0.5),
                        x2 = c("PMX", "MOC","OC","OX2","POS","CX","UX"),
                        #                        x3 = c(50, 100,150,200),
                        x4 = c("Swap","Invert","Memetic 2-opt","Memetic k-opt","Memetic VNS"),
                        x5 = c("A","B")
)

data = cand.list
frml<-~x1*x2*x4*x5


if (!exists(".Random.seed"))
  set.seed(555111666)
seed<-.Random.seed

if (missing(frml) || !inherits(frml,c("formula","character"))) {
  if (missing(data))
    stop("frml and data cannot both be missing.")
  frml<-~.
}

if (missing(data)) {
  # Create a data matrix from the global variables in frml
  frmla<-formula(paste("~-1+",paste(all.vars(frml),sep="",collapse="+"),sep=""))
  data<-data.frame(model.matrix(frmla,data))
}else {
  if (!inherits(data,"data.frame")) {
    # to insure the columns are named
    data<-data.frame(data)   
    if (ncol(data)==1)
      colnames(data)<-"X1"
  }
}
numericColumn<-sapply(data,is.numeric)
frml<-expand.formula(frml,colnames(data),numerics=numericColumn)
X<-model.matrix(frml,data)
model.matrix.default(frml,data)

means<-apply(data[,numericColumn,drop=FALSE],2,mean)
data[,numericColumn]<-sweep(data[,numericColumn,drop=FALSE],2,means)

frml<-expand.formula(frml,colnames(data),numerics=numericColumn)

X<-model.matrix(frml,data)

N <- nrow(X)
k <- ncol(X)

nRound<-0

nTrials<-k+5
if (nTrials<k)
  stop("nTrials must be greater than or equal to the number of columns in expanded X")
nTrials<-as.integer(nTrials) # to be safe
rows<-rep(0,nTrials)
nullify = 1
crit<-0
evaluateI<-FALSE
doSpace=NULL
B<-NULL
RandomStart<-FALSE # this has no effect when approximate!=FALSE since nullify is
augment<-FALSE
approximate=FALSE
proportions<-NULL
maxIteration<-1000
nRepeats<-40
DFrac<-1
CFrac<-1
value<-.Call("FederovOpt", X,as.integer(RandomStart),as.integer(rows),as.integer(nullify),
             as.integer(crit),as.integer(evaluateI),as.integer(doSpace),B,as.integer(augment),as.integer(approximate),
             as.double(proportions),as.integer(nTrials),as.integer(maxIteration),as.integer(nRepeats),
             as.double(DFrac),as.double(CFrac),PACKAGE="AlgDesign")

data[,numericColumn]<-sweep(data[,numericColumn,drop=FALSE],2,-means)
RowNos<-sort(1+((value$rows[1:nTrials])%%N))
Design<-data[RowNos,,drop=FALSE]

Так в чем же дело? Что я скучаю?

1 Ответ

0 голосов
/ 27 октября 2019

Спасибо за ваши усилия. Я нашел решение, это ошибка:

https://github.com/jvbraun/AlgDesign/issues/3

решено закрыть

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...