Commit | Line | Data |
---|---|---|
324febd3 BA |
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") |