| 1 | library(morpheus) |
| 2 | morph <- function(fargs) { |
| 3 | K <- fargs$optargs$K |
| 4 | M <- computeMoments(fargs$X, fargs$Y) |
| 5 | fargs$optargs$M <- M |
| 6 | mu <- computeMu(fargs$X, fargs$Y, fargs$optargs) |
| 7 | res2 <- NULL |
| 8 | tryCatch({ |
| 9 | op <- optimParams(K,link,fargs$optargs) |
| 10 | x_init <- list(p=rep(1/K,K-1), beta=mu, b=rep(0,K)) |
| 11 | res2 <- do.call(rbind, op$run(x_init)) |
| 12 | }, error = function(e) { |
| 13 | res2 <- NA |
| 14 | }) |
| 15 | res2 |
| 16 | } |
| 17 | |
| 18 | #model = binomial; default values: |
| 19 | link = "probit" |
| 20 | N <- 10 |
| 21 | d <- 2 |
| 22 | n <- 1e4 |
| 23 | ncores <- 1 |
| 24 | |
| 25 | if (d == 2) { |
| 26 | K <- 2 |
| 27 | p <- .5 |
| 28 | b <- c(-.2, .5) |
| 29 | beta <- matrix( c(1,-2, 3,1), ncol=K ) |
| 30 | } else if (d == 5) { |
| 31 | K <- 2 |
| 32 | p <- .5 |
| 33 | b <- c(-.2, .5) |
| 34 | beta <- matrix( c(1,2,-1,0,3, 2,-3,0,1,0), ncol=K ) |
| 35 | } else if (d == 10) { |
| 36 | K <- 3 |
| 37 | p <- c(.3, .3) |
| 38 | b <- c(-.2, 0, .5) |
| 39 | beta <- matrix( c(1,2,-1,0,3,4,-1,-3,0,2, 2,-3,0,1,0,-1,-4,3,2,0, -1,1,3,-1,0,0,2,0,1,-2), ncol=K ) |
| 40 | } else if (d == 20) { |
| 41 | K <- 3 |
| 42 | p <- c(.3, .3) |
| 43 | b <- c(-.2, 0, .5) |
| 44 | beta <- matrix( c(1,2,-1,0,3,4,-1,-3,0,2,2,-3,0,1,0,-1,-4,3,2,0, -1,1,3,-1,0,0,2,0,1,-2,1,2,-1,0,3,4,-1,-3,0,2, 2,-3,0,1,0,-1,-4,3,2,0,1,1,2,2,-2,-2,3,1,0,0), ncol=K ) |
| 45 | } |
| 46 | |
| 47 | fargs = list(n=n, p=p, beta=beta, b=b) |
| 48 | fargs$optargs = list(link=link) |
| 49 | |
| 50 | io = generateSampleIO(fargs$n, fargs$p, fargs$beta, fargs$b, fargs$optargs$link) |
| 51 | fargs$X = io$X |
| 52 | fargs$Y = io$Y |
| 53 | fargs$optargs$K = ncol(fargs$beta) |
| 54 | fargs$optargs$M = computeMoments(io$X,io$Y) |
| 55 | |
| 56 | res2 <- morph(fargs) |
| 57 | |
| 58 | save("res2", file="test.RData") |