#store the sequence in a matrix
m.models <- rbind(m.models, c(1,s.index))
j <- j + 1
}
m.matrix <- burn.seq(m.models, len)
result <- result.GibbsSampler(m.matrix, y, x, k, gamma,
p, n.models, info, family)
v.prob <- colSums(m.matrix[,-1])/len
v.select  <- x.predictors[v.prob > tau]
result$v.prob   <- v.prob
result$v.select <- v.select
result$tau      <- tau
result$x.predictors <- x.predictors
return(result)
}
m1.restrict <- GibbsSampler(y, x, n.vars = 50, perm = TRUE, len = 200,
info = "exBIC", family = "binomial")
plots.ichart(m1.restrict)
plots.ichart(m.block)
plots.ichart(m.restrict)
m.block$v.select
m.restrict$v.select
m1.restrict$v.select
devtools::check()
devtools::build()
m1.restrict <- GibbsSampler(y, x, n.vars = 50, perm = TRUE,
info = "exBIC", family = "binomial")
View(GibbsSampler)
plots.ichart(m1.restrict)
m1.restrict$v.select
load("H:/UbuntuRv2/STC/TCG/tcg_swio.RData")
plots.ichart(m.block)
plots.ichart(m.restrict)
plots.mf(m.block)
plots.mf(m.restrict)
plots.vr(m.block)
plots.vr(m.block, n.vars = 50)
plots.vr(m.restrict)
m.block$v.select
m.restrict$v.select
cor(data.train$P_VORT_500, data.train$P_VORT_500)
cor(data.train$P_VORT_500, data.train$P_VORT_400)
plots.vr(m.block)
plots.vr(m.restrict)
load("H:/UbuntuRv2/STC/TCG/tcg_swio_new.RData")
plots.ichart(m.block)
plots.mf(m.block)
plots.vr(m.block)
m.block$v.select
load("H:/UbuntuRv2/STC/TCG/tcg_swio_new.RData")
m.block$v.select
m.restrict$v.select
load("H:/UbuntuRv2/STC/TCG/tcg_swio.RData")
m.block$v.select
m.restrict$v.select
load("H:/UbuntuRv2/STC/TCG/tcg_swio_new.RData")
plots.ichart(m.block)
plots.ichart(m.restrict)
plots.mf(m.block)
plots.mf(m.restrict)
plots.vr(m.block)
plots.vr(m.block, n.vars = 50)
plots.vr(m.restrict)
plots.vr(m.block, n.vars = 50)
plots.vr(m.block)
load("H:/UbuntuRv2/STC/TCG/tcg_ar.RData")
plots.ichart(m.block)
plots.ichart(m.restrict)
plots.mf(m.block)
plots.mf(m.restrict)
m.block$v.select
m.restrict$v.select
load("H:/UbuntuRv2/STC/TCG/tcg_swio_new.RData")
plots.ichart(m.block)
plots.ichart(m.restrict)
plots.mf(m.block)
plots.mf(m.restrict)
plots.vr(m.block)
plots.vr(m.restrict)
m.block$v.select
m.restrict$v.select
2^{16}
load("H:/UbuntuRv2/STC/TCG/tcg_ar_new.RData")
plots.ichart(m.block)
plots.mf(m.block)
plots.vr(m.block)
m.block$v.select
load("H:/UbuntuRv2/STC/TCG/others/tcg_ar_new.RData")
m.block$v.select
m.restrict$v.select
install.packages("devtools")
devtools::install_github("fhebert/SNPSetSimulations",build_opts=NULL)
install.packages("devtools")
install.packages(c("BAS", "bslib", "cachem", "htmltools", "httpuv", "languageserver", "later", "memoise", "openssl", "progressr", "R.utils", "remotes", "rex", "rlang", "shiny", "styler", "tseries", "tsibble"))
install.packages(c("BAS", "bslib", "cachem", "htmltools", "httpuv", "languageserver", "later", "memoise", "openssl", "progressr", "R.utils", "remotes", "rex", "rlang", "shiny", "styler", "tseries", "tsibble"))
install.packages(c("BAS", "bslib", "cachem", "htmltools", "httpuv", "languageserver", "later", "memoise", "openssl", "progressr", "R.utils", "remotes", "rex", "rlang", "shiny", "styler", "tseries", "tsibble"))
install.packages(c("BAS", "bslib", "cachem", "htmltools", "httpuv", "languageserver", "later", "memoise", "openssl", "progressr", "R.utils", "remotes", "rex", "rlang", "shiny", "styler", "tseries", "tsibble"))
install.packages("rlang")
devtools::install_github("fhebert/SNPSetSimulations",build_opts=NULL)
install.packages("GenOrd")
devtools::install_github("fhebert/SNPSetSimulations",build_opts=NULL)
devtools::install_github("fhebert/SNPSetSimulations",build_opts=NULL, force = T)
library(SNPSetSimulations)
vignette("SNPSetSimulations")
?SNPSetSimulations
load("H:/UbuntuRv2/k610ern/VS_SNP_new.RData")
m.block$v.select
load("H:/UbuntuRv2/STC/TCG/tcg_ar_new.RData")
load("H:/UbuntuRv2/STC/TCG/tcg_ar_new.RData")
library(IBGS)
devtools::install()
load("H:/UbuntuRv2/STC/TCG/tcg_ar_new.RData")
plots.ichart(m.block)
library(IBGS)
plots.ichart(m.block)
plots.ichart(m.restrict)
plots.mf(m.block)
plots.mf(m.restrict)
plots.vr(m.block)
#plots.vr(m.block, n.vars = 50)
plots.vr(m.restrict)
m.block$v.select
m.restrict$v.select
m.block$c.models$models[[1]]
m.restrict$c.models$models[[1]]
setwd("H:/UbuntuRv2/k610ern")
load("k610ern.RData")
##omit NA
data_na <- na.omit(data1)
###xy
x1 <- data_na[,-1]
#remove highly correlated predictors
tmp <- cor(x1)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x1.new <- x1[, !apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
x2 <- as.data.frame(lapply(x1.new, as.factor))
View(x2)
y0 <- data_na[,1]
m1 <- glm(y0~x2[,1:3], family = "binomial")
x2[,1:3]
m1 <- glm(y0~x2[,1], family = "binomial")
summary(m1)
m1 <- glm(y0~x2[,1]+ x2[,2], family = "binomial")
summary(m1)
data <- as.data.frame(cbind(y0, x2))
View(data)
m1 <- glm(y0~., data = data[,1:2] family = "binomial")
m1 <- glm(y0~., data = data[,1:2], family = "binomial")
summary(m1)
m1 <- glm(y0~., data = data[,1:3\], family = "binomial")
m1 <- glm(y0~., data = data[,1:3], family = "binomial")
summary(m1)
y0 <- data_na[,1]
data <- as.data.frame(cbind(y0, x2))
n <- dim(x2)[1]
p <- dim(x2)[2]
#train & test
index <- sample(x = 2, size = n, replace = TRUE, prob = c(0.8,0.2))
data.train <- data[index == 1,]
data.test  <- data[index == 2,]
#train set
y <- data.train[,1]
x <- data.train[,-1]
load("k610ern.RData")
##omit NA
data_na <- na.omit(data1)
###xy
x1 <- data_na[,-1]
#remove highly correlated predictors
tmp <- cor(x1)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x1.new <- x1[, !apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
x2 <- as.data.frame(lapply(x1.new, as.factor))
y0 <- data_na[,1]
data <- as.data.frame(cbind(y0, x2))
n <- dim(x2)[1]
p <- dim(x2)[2]
#train & test
index <- sample(x = 2, size = n, replace = TRUE, prob = c(0.8,0.2))
data.train <- data[index == 1,]
data.test  <- data[index == 2,]
#train set
y <- data.train[,1]
x <- data.train[,-1]
dim(x)
#block
m.block <- BlockGibbsSampler(y, x, info = "exBIC", family = "binomial")
x <- as.matrix(data.train[,-1])
#block
m.block <- BlockGibbsSampler(y, x, info = "exBIC", family = "binomial")
#train set
y <- data.train[,1]
x <- data.train[,-1]
attr(x)
summary(x[,1])
data <- as.data.frame(cbind(y, x))
m1 <- glm(y~., data = data[,1:3], family = "binomial")
summary(m1)
x <- as.matrix(data.train[,-1])
data <- as.data.frame(cbind(y, x))
m1 <- glm(y~., data = data[,1:3], family = "binomial")
head(data)
summary(data[,2])
summary(data[,1])
summary(x[,1])
summary(x2[,1])
cbind(x2,vector())
cbind(x2,data.frame())
devtools::check()
devtools::check()
devtools::build()
load("H:/UbuntuRv2/k610ern/VS_SNP_c.RData")
plots.ichart(m.block)
plots.mf(m.block)
plots.vr(m.block)
plots.vr(m.block, n.vars = 50)
m.block$v.select
m.block$c.models$models[[1]]
summary(m.block$c.models$models[[1]])
AICc(m.block$c.models$models[[1]])
AICcmodavg::AICc(m.block$c.models$models[[1]])
exBIC(m.block$c.models$models[[1]])
exBIC(m.block$c.models$models[[1]], gamma = 0.5)
?exBIC
exBIC(m.block$c.models$models[[1]], 0.5, 279)
BIC(m.block$c.models$models[[1]])
load("H:/UbuntuRv2/k610ern/VS_SNP_new.RData")
summary(m.block$c.models$models[[1]])
load("H:/UbuntuRv2/k610ern/VS_SNP.RData")
summary(m.block$c.models$models[[1]])
setwd("H:/UbuntuRv2/STC/Final")
#data
STC <- read.csv("STC.csv")
#predictors
x   <- as.matrix(STC[,10:45])
colnames(x) <- c("DMSLP.Aug", "TMSLP.Aug",  "DMI.Aug",    "DMIE.Aug",    "DMIW.Aug",    "QBO.Aug",
"SOI.Aug",   "N12.Aug",    "N34.Aug",    "N3.Aug",      "N4.Aug",      "EMI.Aug",
"DMSLP.Sep", "TMSLP.Sep",  "DMI.Sep",    "DMIE.Sep",    "DMIW.Sep",    "QBO.Sep" ,
"SOI.Sep"  , "N12.Sep" ,   "N34.Sep" ,   "N3.Sep" ,     "N4.Sep" ,     "EMI.Sep" ,
"DMSLP.Oct", "TMSLP.Oct",  "DMI.Oct" ,   "DMIE.Oct" ,   "DMIW.Oct",    "QBO.Oct" ,
"SOI.Oct" ,  "N12.Oct" ,   "N34.Oct",    "N3.Oct"  ,    "N4.Oct" ,     "EMI.Oct")
tmp <- cor(x)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x.new <- x[, !apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
View(x.new)
setwd("H:/UbuntuRv2/k610ern")
load("H:/UbuntuRv2/k610ern/VS_SNP_c.RData")
plots.ichart(m.block)
plots.mf(m.block)
plots.vr(m.block)
m.block$v.select
plots.vr(m.block, n.vars = 50)
summary(m.block$c.models$models[[1]])
exBIC((m.block$c.models$models[[1]]))
exBIC((m.block$c.models$models[[1]]),0.5,267)
library(SNPSetSimulations)
m <- 100
rho <- 0.8
Sigma <- rho^abs(outer(1:m,1:m,"-"))
View(Sigma)
G <- PopulationSNPSet(1000,Sigma)
G <- PopulationSNPSet(1000,Sigma, p=rep(0.4,m))
G <- PopulationSNPSet(n=1000,Sigma = Sigma, p=rep(0.4,m))
library(SNPSetSimulations)
m <- 100
rho <- 0.8
S <- rho^abs(outer(1:m,1:m,"-"))
G <- PopulationSNPSet(n=1000,Sigma = S, p=rep(0.4,m))
G <- PopulationSNPSet(n=1000,Sigma = S)
G <- PopulationSNPSet(n=100000,Sigma = S)
M <- cbind(rep(1/3,m), rep(2/3,m))
M <- lapply(1:nrow(M), function(i){M[i,]})
G <- PopulationSNPSet(n=1000,Sigma = S, marginal = M)
??`SNPSetSimulations-package`
Y <- SampleSNPPhenotype(G, -1, beta = rep(2,5), I = 50:54 )
Y
View(Y)
save(Y, file = "STC.RData")
save(Y, file = "SNP_simu.RData")
load("SNP_simu.RData")
###xy
x1 <- Y$SNP
#remove highly correlated predictors
tmp <- cor(x1)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x1.new <- x1[, !apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
###xy
x1 <- Y$SNP
x <- as.data.frame(lapply(x1, as.factor))
y <- Y$Phenotype
summary(x1[,1])
View(x)
View(x1)
dim(x1)
x <- as.data.frame(lapply(as.matrix(x1), as.factor))
as.matrix(x1)
load("k610ern.RData")
###xy
x1 <- data_na[,-1]
#remove highly correlated predictors
tmp <- cor(x1)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x1.new <- x1[, !apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
x2 <- as.data.frame(lapply(x1.new, as.factor))
x2 <- as.data.frame(apply(x1.new, 1,as.factor))
x <- as.data.frame(apply(x1,1, as.factor))
View(x)
dim(x1)
x <- as.data.frame(apply(x1,2, as.factor))
summary(x[,1])
x[,1]
load("k610ern.RData")
##omit NA
data_na <- na.omit(data1)
###xy
x1 <- data_na[,-1]
x2 <- as.data.frame(lapply(x1, as.factor))
x10 <- as.data.frame(x1)
x <- as.data.frame(lapply(x10, as.factor))
load("SNP_simu.RData")
###xy
x1 <- as.data.frame(Y$SNP)
x <- as.data.frame(lapply(x1, as.factor))
y <- Y$Phenotype
summary(x[,1])
devtools::build()
devtools::build()
load("H:/UbuntuRv2/k610ern/VS_SNP_simu1.RData")
plots.ichart(m.block)
library(IBGS)
plots.ichart(m.block)
plots.mf(m.block)
plots.vr(m.block)
m.block$v.select
summary(m.block$c.models$models[[1]])
m2 <- glm(y~x[,50:54], family = binomial())
m2 <- glm(y~as.matrix(x[,50:54]), family = binomial())
m2 <- glm(y~., data = as.data.frame(cbind(y,x[,50:54])), family = binomial())
summary(m2)
m3 <- glm(y~., data = as.data.frame(cbind(y,x1[,50:54])), family = binomial())
summary(m3)
load("H:/UbuntuRv2/k610ern/VS_SNP_simu2.RData")
plots.ichart(m.block)
plots.mf(m.block)
plots.vr(m.block)
m.block$v.select
summary(m.block$c.models$models[[1]])
sum(cor(x) > 0.9)
sum(cor(x) > 0.9 - 100)
sum(cor(x) > 0.9)-100
head(cor(x))
m3 <- glm(y~., data = as.data.frame(cbind(y,x[,50:54]), binomial()))
m3 <- glm(y~., data = as.data.frame(cbind(y, x[,50:54])), binomial())
summary(m3)
summary(m.block$c.models$models[[1]])
load("k610ern.RData")
setwd("H:/UbuntuRv2/k610ern")
load("k610ern.RData")
##omit NA
data_na <- na.omit(data1)
###xy
x1 <- data_na[,-1]
#remove highly correlated predictors
tmp <- cor(x1)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x2 <- x1[, !apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
y0 <- data_na[,1]
data <- as.data.frame(cbind(y0, x2))
summary(x[,1])
load("H:/UbuntuRv2/k610ern/VS_SNP_c2.RData")
plots.ichart(m.block)
plots.mf(m.block)
plots.vr(m.block)
load("H:/UbuntuRv2/k610ern/VS_SNP_c2.RData")
m.block$v.select
plots.vr(m.block)
load("H:/UbuntuRv2/k610ern/VS_SNP_c2.RData")
load("H:/UbuntuRv2/k610ern/VS_SNP_c2.RData")
plots.ichart(m.block)
plots.mf(m.block)
plots.vr(m.block)
m.block$v.select
plots.vr(m.block, n.vars = 50)
summary(m.block$c.models$models[[1]])
load("k610ern.RData")
library(IBGS)
library(doParallel)
registerDoParallel(12)
##omit NA
data_na <- na.omit(data1)
###xy
x1 <- data_na[,-1]
#remove highly correlated predictors
tmp <- cor(x1)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x2 <- x1[, !apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
y0 <- data_na[,1]
data <- as.data.frame(cbind(y0, x2))
n <- dim(x2)[1]
p <- dim(x2)[2]
m.restrict <- GibbsSampler(y0, x2, info = "exBIC", family = "binomial")
m.restrict <- GibbsSampler(y0, x2, n.vars = 20, info = "exBIC", family = "binomial")
plots.ichart(m.restrict)
plots.mf(m.block)
plots.mf(m.restrict)
plots.vr(m.block)
plots.vr(m.block, n.vars = 50)
plots.vr(m.restrict)
m.block$v.select
m.restrict$v.select
summary(m.block$c.models$models[[1]])
summary(m.restrict$c.models$models[[1]])
m4 <- glm(y0~x2$rs1004984_A + x2$rs1131878_C + x2$rs1845557_C + x2$rs2300697_C +
x2$rs2476923_A, family = binomial())
summary(m4)
m4 <- glm(y0~x2$rs1004984_A + x2$rs1131878_C + x2$rs1845557_C + x2$rs2300697_C +
x2$rs2476923_A + x2$rs248805_A + x2$rs2547231_C + x2$rs2758331_A +
x2$rs3760802_A + x2$rs4147581_G + x2$rs4702374_G + x2$rs4952220_C +
x2$rs6163_A, family = binomial())
summary(m4)
exBIC(m4)
exBIC(m4,0.5,279)
m5 <- glm(y0~x1$rs1004984_A + x1$rs1131878_C + x1$rs12917295_G + x1$rs1845557_C + x1$rs2300697_C +
x1$rs2476923_A + x1$rs248805_A + x1$rs2547231_C + x1$rs2758331_A +
x1$rs3760802_A + x1$rs4147581_G + x1$rs4702374_G + x1$rs4952220_C +
x1$rs6163_A + x1$rs6902771_T + x1$rs7706809_T, family = binomial())
summary(m5)
x4 <- x1
x1 <- as.data.frame(lapply(x1, as.factor))
m5 <- glm(y0~x1$rs1004984_A + x1$rs1131878_C + x1$rs12917295_G + x1$rs1845557_C + x1$rs2300697_C +
x1$rs2476923_A + x1$rs248805_A + x1$rs2547231_C + x1$rs2758331_A +
x1$rs3760802_A + x1$rs4147581_G + x1$rs4702374_G + x1$rs4952220_C +
x1$rs6163_A + x1$rs6902771_T + x1$rs7706809_T, family = binomial())
summary(m5)
summary(m.restrict$c.models$models[[1]])
summary(m.block$c.models$models[[1]])
###remove highly correlation predictors
remove.highly.cor <- function(x, rho){
tmp <- cor(x)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x1 <- x[, !apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
x2 <- x[,  apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
x0 <- list()
x0$extracted <- x1
x0$removed   <- x2
return(x0)
}
###remove highly correlation predictors
remove.highly.cor <- function(x, rho){
tmp <- cor(x)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x1 <- x[, !apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
x2 <- x[,  apply(tmp, 2, function(x) any(abs(x) > 0.95, na.rm = TRUE))]
x0 <- list()
x0$extracted <- x1
x0$removed   <- x2
return(x0)
}
###remove highly correlation predictors
remove.highly.cor <- function(x, rho){
tmp <- cor(x)
tmp[upper.tri(tmp)] <- 0
diag(tmp) <- 0
x1 <- x[, !apply(tmp, 2, function(x) any(abs(x) > rho, na.rm = TRUE))]
x2 <- x[,  apply(tmp, 2, function(x) any(abs(x) > rho, na.rm = TRUE))]
x0 <- list()
x0$extracted <- x1
x0$removed   <- x2
return(x0)
}
x9 <- remove.highly.cor(x1, 0.95)
x1 <- x4
x9 <- remove.highly.cor(x1, 0.95)
View(x9)
divide <- function(x, prob = c(0.8,0.2)){
n <- dim(x)[1]
index <- sample(x = 2, size = n, replace = TRUE, prob)
x0 <- list()
x0$train <- data[index == 1,]
x0$test  <- data[index == 2,]
return(x0)
}
x10 <- divide(x1)
View(x10)
x1 <- as.data.frame(lapply(x1, as.factor))
m5 <- glm(y0~x1$rs1004984_A + x1$rs1131878_C + x1$rs12917295_G + x1$rs1845557_C + x1$rs2300697_C +
x1$rs2476923_A + x1$rs248805_A + x1$rs2547231_C + x1$rs2758331_A +
x1$rs3760802_A + x1$rs4147581_G + x1$rs4702374_G + x1$rs4952220_C +
x1$rs6163_A + x1$rs6902771_T + x1$rs7706809_T, family = binomial())
summary(m5)
load("H:/UbuntuRv2/k610ern/VS_SNP_c1.RData")
summary(m.block$c.models$models[[1]])
load("H:/UbuntuRv2/k610ern/VS_SNP_simu2.RData")
plots.vr(m.block)
m.restrict <- GibbsSampler(y0, x2, n.vars = 20, info = "BIC", family = "binomial")
x <- matrix(rnorm(100*100), ncol = 100)
y <- rowSums(x[,1:10]) + rnorm(100)
bic.v <- rep(0,100)
for(i in 1:100){
bic.v[i] <- BIC(glm(y~x[,1:i]))
}
plot(bic.v)
plot(bic.v[1:98])
