Related
I want to study mixture Copula for reliability analysis.however I can't construct RVINEMatrix ，
Therefore, the probability integral transformation （PIT） cannot be performed、 The copula used in H-equation to convert related variables into independent variables cannot be filled with mixed copulas。
Here is my code：
copula1 <- mixCopula(list(claytonCopula(param = 1.75,dim = 2),
frankCopula(param = 0.718,dim = 2),
gumbelCopula(param = 1.58,dim = 2)),w=c(0.4492,0.3383,0.2125))
copula2 <- mixCopula(list(frankCopula(param = 0.69,dim = 2),
gumbelCopula(param = 1.48,dim = 2),
claytonCopula(param = 1.9,dim = 2)),w=c(0.3784,0.3093,0.3123))
copula3 <- mixCopula(list(frankCopula(param = 7.01,dim = 2),
claytonCopula(param = 0.75,dim = 2),
gumbelCopula(param = 1.7,dim = 2)),w=c(0.4314,0.2611,0.3075))
copula4 <- mixCopula(list(gumbelCopula(param = 1.21,dim = 2),
claytonCopula(param = 0.89,dim = 2),
frankCopula(param = 3.62,dim = 2)),w=c(0.3306,0.2618,0.4076))
.......
Matrix <- c (5, 4, 3, 2, 1,
0, 4, 3, 2, 1,
0, 0, 3, 2, 1,
0, 0, 0, 2, 1,
0, 0, 0, 0, 1)
Matrix <- matrix(Matrix, 5, 5)
family1 <- c(0,copula10,copula9,copula7, copula4,
0, 0, copula8,copula6, copula3,
0, 0, 0, copula5, copula2,
0, 0, 0, 0, copula1,
0, 0, 0, 0, 0)
family1 <- matrix(family1, 5, 5)
par <- c(0, 0.2, 0.5,0.32, 0.50,``
0, 0, 0.5, 0.98, 0.5,
0, 0, 0, 0.9 , 0.5,
0, 0, 0, 0, 0.39,
0, 0, 0, 0, 0)
par <- matrix(par, 5, 5)
par2 <- c(0, 0, 0, 0, 0,
0, 0, 0, 0, 0,
0, 0, 0, 0, 0,
0, 0, 0, 0, 0,
0, 0, 0, 0, 0)
par2 <- matrix(par2, 5, 5)
RVM <- RVineMatrix(Matrix = Matrix, family = family1,
par = par, par2 = par2,
names = c("V1", "V2", "V3", "V4", "V5"),check.pars = TRUE)
so could you help me to construct the rvinematrix ? or Achieve this by other means. thanks！
There are some points you should be aware of:
You use the mixcopula from the copula package. That will provide you with a mixture model with a copula, not a mixture of R-vine copula.
Then you try to fit the copula generated from the mixture of copula into the Rvine copula model. This will not work because the index for copula functions in the R-vine copula is different from the one in the copula package. So, Rvine matrix accepts only a number, where each number corresponds to a specific type of copula.
So, to build a mixture of the R-vine copula model, you should build a mixture of R-vine densities. There exist a clustering GitHub package, called vineclust. It is designed for vine copula clustering models. By the way, for the mixture of Rvine copula, you need (for two components), two matrices of families, parameters, and Matrix.
An example of vine mixture from vineclust is:
dims <- 3
obs <- c(500,500)
RVMs <- list()
RVMs[[1]] <- VineCopula::RVineMatrix(Matrix=matrix(c(1,3,2,0,3,2,0,0,2),dims,dims),
family=matrix(c(0,3,4,0,0,14,0,0,0),dims,dims),
par=matrix(c(0,0.8571429,2.5,0,0,5,0,0,0),dims,dims),
par2=matrix(sample(0, dims*dims, replace=TRUE),dims,dims))
RVMs[[2]] <- VineCopula::RVineMatrix(Matrix=matrix(c(1,3,2,0,3,2,0,0,2), dims,dims),
family=matrix(c(0,6,5,0,0,13,0,0,0), dims,dims),
par=matrix(c(0,1.443813,11.43621,0,0,2,0,0,0),dims,dims),
par2=matrix(sample(0, dims*dims, replace=TRUE),dims,dims))
margin <- matrix(c('Normal', 'Gamma', 'Lognormal', 'Lognormal', 'Normal', 'Gamma'), 3, 2)
margin_pars <- array(0, dim=c(2, 3, 2))
margin_pars[,1,1] <- c(1, 2)
margin_pars[,1,2] <- c(1.5, 0.4)
margin_pars[,2,1] <- c(1, 0.2)
margin_pars[,2,2] <- c(18, 5)
margin_pars[,3,1] <- c(0.8, 0.8)
margin_pars[,3,2] <- c(1, 0.2)
x_data <- rvcmm(dims, obs, margin, margin_pars, RVMs)
I am trying to make run this model. I am trying to maximize:x[4]
w.r.t Mv = c(0,0,0,0)
lb < v < ub
But I have 2 problems, first matrix multiplication.
library(ompr)
lb <- c(-200, 0, -200, -200)
ub <- c(1000, 1000, 1000, 1000)
M <- matrix(rbind(
c(-1, 0, -1, 0), # A
c(-1, 0, 0, -2), # B
c(1, -2, 0, 0), # C
c(1, 0, 0, 2), # D
c(0, 2, -1, 0), # E
c(0, 0, 1, -1) # F
), nrow = 6)
n <- 4
rhs <- rep(0, n)
model <- MIPModel() %>%
add_variable(x[i], i = 1:n, type = "continuous") %>%
set_objective(x[4]) %>%
add_constraint(M[i, ] %*% x == rhs[i], i = 1:n)
I got the following error.
Error in M[i, ] %*% x : requires numeric/complex matrix/vector
arguments
Second, I am trying to set the bounds in a vectorized way, but I don't know how to do that. I tried the following:
set_bounds(x[i], ub = ub[i], lb = lb[i], i = 1:n)
This gives:
object 'i' not found
Any help would be very useful!
Works like this, but the solution is (0, 0, 0, 0):
library(ompr)
library(ompr.roi)
library(ROI.plugin.glpk)
library(magrittr)
lb <- c(-200, 0, -200, -200)
ub <- c(1000, 1000, 1000, 1000)
M <- matrix(rbind(
c(-1, 0, -1, 0), # A
c(-1, 0, 0, -2), # B
c(1, -2, 0, 0), # C
c(1, 0, 0, 2), # D
c(0, 2, -1, 0), # E
c(0, 0, 1, -1) # F
), nrow = 6)
n <- 4
rhs <- rep(0, n)
model <- MIPModel() %>%
add_variable(x[i], i = 1:n, type = "continuous") %>%
set_objective(x[4], "max") %>%
add_constraint(sum_over(M[i, j] * x[j], j = 1:4) == rhs[i], i = 1:n) %>%
add_constraint(x[i] <= ub[i], i = 1:n) %>%
add_constraint(x[i] >= lb[i], i = 1:n) %>%
solve_model(with_ROI(solver = "glpk"))
get_solution(model, x[i])
I have a list that looks something like this (a must-reduced version of a list with 301 sub-elements):
myList <- list()
myList$Speaker1 <- list("ID" = c(1, 2, 3, 4, 5),
"S1C1.Sonorant" = c(0, 0, 0, 0.5, 0, -1),
"S1C1.Consonantal" = c(0, 0, 0, 0, 0, 1),
"S1C1.Voice" = c(0, 0, 1, 1, 1, -1),
"S1C1.Nasal" = c(0, 0, 1, 0, 1, -1))
myList$Speaker2 <- list("ID" = c(1, 2, 3, 4, 5),
"S1C1.Sonorant" = c(0, 0, 0, 0.5, 0, -1),
"S1C1.Consonantal" = c(0, 0, 0, 0, 0, 1),
"S1C1.Voice" = c(0, 0, 1, 1, 1, -1),
"S1C1.Nasal" = c(0, 0, 1, 0, 1, -1))
myList$Speaker3 <- list("ID" = c(1, 2, 3, 4, 5),
"S1C1.Sonorant" = c(0, 0, 0, 0.5, 0, -1),
"S1C1.Consonantal" = c(0, 0, 0, 0, 0, 1),
"S1C1.Voice" = c(0, 0, 1, 1, 1, -1),
"S1C1.Nasal" = c(0, 0, 1, 0, 1, -1))
For each speaker, I want to run some functions through all the sub-elements that include the string S1C1.. So far, I have the following, which calls each column containing S1C1 individually:
my_matrix <- lapply(myList, FUN = function(element) {
ones <- rep(1, nrow(element)) # count repeated rows
sonorant_vec.S1C1 <- element$S1C1.Sonorant
sonorant_mat.S1C1 <- (sonorant_vec.S1C1 %*% t(ones) - ones %*% t(sonorant_vec.S1C1))^2
consonantal_vec.S1C1 <- element$S1C1.Consonantal
consonantal_mat.S1C1 <- (consonantal_vec.S1C1 %*% t(ones) - ones %*% t(consonantal_vec.S1C1))^2
voice_vec.S1C1 <- element$S1C1.Voice
voice_mat.S1C1 <- (voice_vec.S1C1 %*% t(ones) - ones %*% t(voice_vec.S1C1))^2
nasal_vec.S1C1 <- element$S1C1.Nasal
nasal_mat.S1C1 <- (nasal_vec.S1C1 %*% t(ones) - ones %*% t(nasal_vec.S1C1))^2
mat.S1C1 <- sonorant_mat.S1C1 +
consonantal_mat.S1C1 +
voice_mat.S1C1 +
nasal_mat.S1C1
rownames(mat.S1C1) <- element$S1C1.S1C1
colnames(mat.S1C1) <- element$S1C1.S1C1
all_mat <- sqrt(mat.S1C1[,])
return(all_mat)
})
Is there a way I can iterate through all the sub-elements that start with the string S1C1.? The current code works but is very long!
I am analyzing a data set where ~10 individuals are exposed to a set treatment (Time) and mortality is recorded (Alive, Dead). glmer was used to model the data because Treatments were blocked (Trial).
From the following model I want to predict the Time at which 50% of individuals die.
Trial <- c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3)
Time <- c(2, 6, 9, 12, 15, 18, 21, 24, 1, 2, 3, 4, 5, 6, 1.5, 3, 4.5, 6, 39)
Alive <- c(10, 0, 0, 0, 0, 0, 0, 0, 6, 2, 8, 1, 0, 0, 4, 6, 1, 2, 0)
Dead <- c(0, 10, 6, 10, 10, 10, 7, 10, 0, 8, 1, 9, 10, 10, 5, 0, 8, 6, 10)
ostrinaA.glmm<- glmer(cbind(Alive, Dead)~Time+(1|Trial), family = binomial(link="logit"))
summary(ostrinaA.glmm)
If I was simply modelling using glmthe dose.p function from MASS could be used. From a different forum I found generalized code for a dose.p.glmm from Bill Pikounis. It is as follows:
dose.p.glmm <- function(obj, cf = 1:2, p = 0.5) {
eta <- obj$family$linkfun(p)
b <- fixef(obj)[cf]
x.p <- (eta - b[1L])/b[2L]
names(x.p) <- paste("p = ", format(p), ":", sep = "")
pd <- -cbind(1, x.p)/b[2L]
SE <- sqrt(((pd %*% vcov(obj)[cf, cf]) * pd) %*% c(1, 1))
res <- structure(x.p, SE = SE, p = p)
class(res) <- "glm.dose"
res
}
I'm new to coding and need help adjusting this code for my model. My attempt is as follows:
dose.p.glmm <- function(ostrinaA.glmm, cf = 1:2, p = 0.5) {
eta <- ostrinaA.glmm$family$linkfun(p)
b <- fixef(ostrinaA.glmm)[cf]
x.p <- (eta - b[1L])/b[2L]
names(x.p) <- paste("p = ", format(p), ":", sep = "")
pd <- -cbind(1, x.p)/b[2L]
SE <- sqrt(((pd %*% vcov(obj)[cf, cf]) * pd) %*% c(1, 1))
res <- structure(x.p, SE = SE, p = p)
class(res) <- "glm.dose"
res
}
dose.p.glmm(ostrinaA.glmm, cf=1:2, p=0.5)
Error in ostrinaA.glmm$family : $ operator not defined for this S4 class
Any assistance adjusting this code for my model would be greatly appreciated.
At a quick glance I would think replacing
eta <- obj$family$linkfun(p)
with
f <- family(obj)
eta <- f$linkfun(p)
should do the trick.
You also need to replace the res <- ... line with
res <- structure(x.p, SE = matrix(SE), p = p)
This is rather obscure, but is necessary because the print.dose.glm method (from the MASS package) automatically tries to cbind() some stuff together. This fails if SE is a fancy matrix from the Matrix package rather than a vanilla matrix from base R: matrix() does the conversion.
If you are very new to coding, you might not realize that you don't have to change the obj variable name in the code you've copied to ostrina.glmm. In other words, Pikounis's code should work perfectly well with only the two modifications I suggested above.
I recently asked a question about looping a glm command for all possible combinations of independent variables. Another user provided a great answer that runs all possible models, however I can't figure out how to produce a data.frame of all possible p-values.
The code suggested in the previous question works for independent variables that are binary (pasted below). However, several of my variables are categorical. Is there any way to adjust the code so that I can produce a table of all p-values for every possible model (there are 2,046 possible models with 10 independent variables...)?
# p-values in a data.frame
p_values <-
cbind(formula_vec, as.data.frame ( do.call(rbind,
lapply(glm_res, function(x) {
coefs <- coef(x)
rbind(c(coefs[,4] , rep(NA, length(ind_vars) - length(coefs[,4]) + 1)))
})
)))
An example of one independent variable is "Bedrock" where possible categories include: "till," "silt," and "glacial deposit." It's not feasible to assign a numerical value to these variables, which is part of the problem. Any suggestions would be appreciated.
In case of additional categorical variable IndVar4 (factor a, b, c) the coefficient table can be more than just a row longer. Adding variable IndVar4:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.7548180 1.4005800 -1.2529223 0.2102340
IndVar1 -0.2830926 1.2076534 -0.2344154 0.8146625
IndVar2 0.1894432 0.1401217 1.3519903 0.1763784
IndVar3 0.1568672 0.2528131 0.6204867 0.5349374
IndVar4b 0.4604571 1.0774018 0.4273773 0.6691045
IndVar4c 0.9084545 1.0943227 0.8301523 0.4064527
Max number of rows is less then all variables + all categories:
max_values <- length(ind_vars) +
sum(sapply( dfPRAC, function(x) pmax(length(levels(x))-1,0)))
So the new corrected function is:
p_values <-
cbind(formula_vec, as.data.frame ( do.call(rbind,
lapply(glm_res, function(x) {
coefs <- coef(x)
rbind(c(coefs[,4] , rep(NA, max_values - length(coefs[,4]) + 1)))
})
)))
But the result is not so clean as with continuous variables. I think Metrics' idea to convert every categorical variable to (levels-1) dummy variables gives same results and maybe cleaner presentation.
Data:
dfPRAC <- structure(list(DepVar1 = c(0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 1, 1,
1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 1), DepVar2 = c(0, 1, 0, 0,
1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1),
IndVar1 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1,
0, 0, 0, 1, 0, 0, 0, 1, 0),
IndVar2 = c(1, 3, 9, 1, 5, 1,
1, 8, 4, 6, 3, 15, 4, 1, 1, 3, 2, 1, 10, 1, 9, 9, 11, 5),
IndVar3 = c(0.500100322564443, 1.64241601558441, 0.622735778490702,
2.42429812749226, 5.10055213237027, 1.38479786027561, 7.24663629203007,
0.5102348706939, 2.91566510995229, 3.73356170379198, 5.42003495939846,
1.29312896116503, 3.33753833987496, 0.91783513806083, 4.7735736131668,
1.17609362602233, 5.58010703426296, 5.6668754863739, 1.4377813063642,
5.07724130837643, 2.4791994535923, 2.55100067348583, 2.41043629522981,
2.14411703944206)), .Names = c("DepVar1", "DepVar2", "IndVar1",
"IndVar2", "IndVar3"), row.names = c(NA, 24L), class = "data.frame")
dfPRAC$IndVar4 <- factor(rep(c("a", "b", "c"),8))
dfPRAC$IndVar5 <- factor(rep(c("d", "e", "f", "g"),6))
Set up the models:
dep_vars <- c("DepVar1", "DepVar2")
ind_vars <- c("IndVar1", "IndVar2", "IndVar3", "IndVar4", "IndVar5")
# create all combinations of ind_vars
ind_vars_comb <-
unlist( sapply( seq_len(length(ind_vars)),
function(i) {
apply( combn(ind_vars,i), 2, function(x) paste(x, collapse = "+"))
}))
# pair with dep_vars:
var_comb <- expand.grid(dep_vars, ind_vars_comb )
# formulas for all combinations
formula_vec <- sprintf("%s ~ %s", var_comb$Var1, var_comb$Var2)
# create models
glm_res <- lapply( formula_vec, function(f) {
fit1 <- glm( f, data = dfPRAC, family = binomial("logit"))
fit1$coefficients <- coef( summary(fit1))
return(fit1)
})
names(glm_res) <- formula_vec