Unverified Commit 708c7c8f authored by Armin Rauschenberger's avatar Armin Rauschenberger Committed by GitHub
Browse files

Delete .Rhistory

parent 71948291
## abline(v=sd(y),col="grey",lty=2)
list[[i]] <- colasso::bilasso_compare(y=y,cutoff=0,X=X)
}
save(list,file="C:/Users/armin.rauschenberger/Desktop/trial.RData")
loss <- list()
name <- names(list[[1]])
for(i in seq_along(name)){
loss[[name[i]]] <- t(sapply(X=list,FUN=function(x) x[[name[i]]]))
}
t(sapply(loss,colMeans))
t(sapply(X=loss,FUN=function(x) apply(x,2,median)))
list
loss <- list()
name <- names(list[[1]])
for(i in seq_along(name)){
loss[[name[i]]] <- t(sapply(X=list,FUN=function(x) x[[name[i]]]))
}
t(sapply(loss,colMeans))
t(sapply(X=loss,FUN=function(x) apply(x,2,median)))
names(list[[1]])
set.seed(1)
grid <- expand.grid(prob=seq(from=0.1,to=0.2,length.out=101),
fac=seq(from=0.5,to=2,length.out=101))
grid <- grid[sample(seq_len(nrow(grid))),]
list <- list()
for(i in 1:nrow(grid)){
cat(i," ")
temp <- colasso:::.simulate(n=100,p=200,prob=grid$prob[i],fac=grid$fac[i])
y <- temp$y; X <- temp$X
if(sd(y)==0){next}
fit <- colasso::bilasso(y=y,cutoff=0,X=X)
## plot(fit)
## plot(x=fit$sigma,y=fit$sigma.cvm)
## abline(v=fit$sigma.min,col="red",lty=2)
## abline(v=sd(y),col="grey",lty=2)
list[[i]] <- colasso::bilasso_compare(y=y,cutoff=0,X=X)
}
loss <- list()
name <- names(list[[1]])
for(i in seq_along(name)){
loss[[name[i]]] <- t(sapply(X=list,FUN=function(x) x[[name[i]]]))
}
t(sapply(loss,colMeans))
t(sapply(X=loss,FUN=function(x) apply(x,2,median)))
set.seed(2)
grid <- expand.grid(prob=seq(from=0.1,to=0.2,length.out=101),
fac=seq(from=0.5,to=2,length.out=101))
grid <- grid[sample(seq_len(nrow(grid))),]
list <- list()
for(i in 1:nrow(grid)){
cat(i," ")
temp <- colasso:::.simulate(n=100,p=200,prob=grid$prob[i],fac=grid$fac[i])
y <- temp$y; X <- temp$X
if(sd(y)==0){next}
#fit <- colasso::bilasso(y=y,cutoff=0,X=X)
## pred <- colasso:::predict.bilasso(fit,newx=X)
## colasso:::plot.bilasso(fit)
list[[i]] <- colasso::bilasso_compare(y=y,cutoff=0,X=X)
}
save(list,file="C:/Users/armin.rauschenberger/Desktop/trial.RData")
?glmnet
?glmnet::glmnet
colasso:::bilasso()
colasso:::bilasso
?glmnet
?glmnet::glmnet
y <- rpois(100,lambda=4)
x <- rnorm(x)
x <- rnorm(100)
mod <- glm(y~x,family="poisson")
predict(mod)
install.packages("available")
available::avaiable("available")
library(available)
available("available")
available("palasso")
#--- generate toydata ----------------------------------------------------------
set.seed(1)
#toydata <- NULL
#save(toydata,file=file.path("C:/Users/armin.rauschenberger/Desktop/package/cornet/data/toydata.R"))
#--- compile package -----------------------------------------------------------
rm(list=ls())
name <- "cornet"
#load("D:/cornet/package/toydata.RData")
pkg <- "C:/Users/armin.rauschenberger/Desktop/cornet/cornet"
setwd(dir=pkg)
devtools::as.package(x=pkg,create=FALSE)
devtools::load_all(path=pkg)
#usethis::use_data(toydata,overwrite=TRUE)
devtools::document(pkg=pkg)
unlink(file.path(pkg,"vignettes","figure"),recursive=TRUE)
all <- dir(file.path(pkg,"vignettes"))
#delete <- "..."
#sapply(delete,function(x) file.remove(file.path(pkg,"vignettes",x)))
setwd(dir=pkg)
unlink(file.path(pkg,"docs"),recursive=TRUE)
pkgdown::build_site(pkg=pkg)
file.remove(file.path(pkg,".Rbuildignore"))
usethis::use_build_ignore(files=c("Readme.Rmd",".travis.yml","_pkgdown.yml","docs","cran-comments.md","appveyor.yml"))
devtools::check(pkg=pkg,quiet=FALSE,manual=TRUE)
devtools::install(pkg=pkg,upgrade=FALSE)
set.seed(1)
devtools::install_github("rauschenberger/cornet")
rm(list=ls(all.names=TRUE))
#devtools::install_github("rauschenberger/decline")
.source <- "C:/Users/armin.rauschenberger/Desktop/package/data"
.target <- "C:/Users/armin.rauschenberger/Desktop/package/decline/data"
project <- "ppmi" # "luxpark" or "ppmi"
if(project=="luxpark"){
load(file.path(.source,"luxpark_2018-12-04.RData"))
if(any(Y$visit0!=X$question113_113,na.rm=TRUE)){stop("Mismatch.")}
if(any(rownames(Y)!=rownames(Xs))){stop("Mismatch!")}
} else if(project=="ppmi"){
load(file.path(.source,"ppmi_2018-11-20.RData"))
if(any(Y[,"visit0"]!=X$"MOCA-MCATOT",na.rm=TRUE)){stop("Mismatch.")}
} else if(project=="trial"){
load(file.path(.source,"ppmi_trial_2019-11-01.RData"))
}
if(any(rownames(Y)!=rownames(X))){stop("Mismatch.")}
temp <- decline:::response(x=Y,type="average")
Y$sign <- temp$sign; Y$diff <- temp$diff
# y <- 1*(Y[,"visit1"] - Y[,"visit0"] < - 5) # alternative
# y <- 1*(Y[,"visit1"] > Y[,"visit0"]) # original (but wrong)
cond <- !is.na(Y$diff)
Y <- Y[cond,]; X <- X[cond,]
if(project=="trial"){
seq <- seq[cond,]
}
# Xs <- Xs[cond,] # selected set
X <- decline::curate_missing(X)
X <- decline::curate_hidden(X)
X <- decline::curate_levels(X)
X <- decline::curate_constant(X)
set.seed(1)
X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_random(X))
#X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_mean(X))
#X_imp <- VIM::kNN(data=X)[,1:ncol(x)/2]) # worse
#library(mice)
#X_imp <- mice::complete(data=mice::mice(Xs,m=5,maxit=5,method="pmm",seed=1),action="all")
# refit
x <- scale(decline::curate_dummies(as.data.frame(X_imp[[2]])))
# refit
x <- scale(decline::curate_dummies(as.data.frame(X_imp[[1]])))
fit <- cornet::cornet(y=Y$diff,cutoff=-1,X=x)
plot(fit)
predict(fit)
predict(fit,newx=x)
pred <- predict(fit,newx=X)
pred <- predict(fit,newx=x)
plot(pred$binomial,pred$grid)
hist(pred$binomial)
pred <- predict(fit,newx=x)
plot(pred$binomial,pred$grid)
plot(pred$binomial,pred$grid); abline(a=0,b=1,lty=2)
plot(pred$binomial,pred$grid,ylim=c(0,1),xlim=c(0,1)); abline(a=0,b=1,lty=2)
fit$trial.min
fit <- cornet::cornet(y=Y$diff,cutoff=-1,X=x)
cornet::plot.cornet(fit)
cornet:::plot.cornet(fit)
fit$sigma.min
fit$pi.min
fit$pi.min
fit$sigma.min
fit$pi.min
fit$sigma.min
cornet:::plot.cornet(fit)
fit$pi.min
fit$sigma.min
coef(fit)
coef <- cornet:::coef.cornet(fit)
dim(coef)
coef==0
rowMeans(coef==0)
rowMeans(as.matrix(coef)==0)
coef <- as.matrix(cornet:::coef.cornet(fit))
coef[rowMeans(coef==0),]
coef <- as.matrix(cornet:::coef.cornet(fit))
head(coef)
coef[which(rowMeans(coef==0)),]
coef[rowMeans(coef==0)==1,]
coef[rowMeans(coef==0)!=1,]
coef <- as.matrix(cornet:::coef.cornet(fit))
coef[rowMeans(coef==0)!=1,]
sel <- coef[rowMeans(coef==0)!=1,]
dim(sel)
head(sel)
coef <- as.matrix(cornet:::coef.cornet(fit))
coef <- coef[rowMeans(coef==0)!=1,]
plot(coef)
plot(coef$beta,coef$gamma)
plot(coef)
plot(log(coef))
beta <- coef["beta",]
beta <- coef[,"beta"]
gamma <- coef[,"gamma"]
beta
gamma
plot(beta,gamma)
range(beta)
range(gamma)
plot(beta+gamma)
graphics::plot.new()
graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
graphics::box()
graphics::plot.new()
graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
graphics::box()
graphics::abline(side=1)
graphics::abline(side=2)
graphics::plot.new()
graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
graphics::box()
graphics::axis(side=1)
graphics::axis(side=2)
barplot(table(beta,gamma),col=c("darkblue","red")
barplot(table(beta,gamma),col=c("darkblue","red"))
barplot(table(beta,gamma),col=c("darkblue","red"))
graphics::plot.new()
graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
graphics::box()
graphics::axis(side=1)
graphics::axis(side=2)
counts <- table(mtcars$vs, mtcars$gear)
barplot(counts, main="Car Distribution by Gears and VS",
xlab="Number of Gears", col=c("darkblue","red"),
legend = rownames(counts), beside=TRUE)
counts
graphics::plot.new()
graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
graphics::box()
graphics::axis(side=1)
graphics::axis(side=2)
graphics::point(beta)
graphics::points(beta)
graphcis::points(gamma)
graphics::points(gamma)
graphics::points(gamma,col="red")
graphics::points(beta,col="blue")
graphics::points(gamma,col="red")
graphics::plot.new()
graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
graphics::box()
graphics::axis(side=1)
graphics::axis(side=2)
graphics::points(abs(beta),col="blue")
graphics::points(-abs(gamma),col="red")
graphics::plot.new()
graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma,-beta,-gamma)))
graphics::box()
graphics::axis(side=1)
graphics::axis(side=2)
graphics::points(abs(beta),col="blue")
graphics::points(-abs(gamma),col="red")
plot(beta,gamma)
plot(rank(beta),rank(gamma))
order(beta)
plot(order(beta),order(gamma))
plot(rank(beta),rank(gamma))
graphics::plot.new()
graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma,-beta,-gamma)))
graphics::box()
graphics::axis(side=1)
graphics::axis(side=2)
graphics::points(abs(beta),col="blue")
graphics::points(-abs(gamma),col="red")
sign(beta)==sign(gamma)
mean(sign(beta)==sign(gamma))
sign(beta)
sign(gamma)
sum(beta==)
sum(beta==0)
sum(gamma==0)
# number of improvements (lasso, cutoff -1)
dev1 <- sapply(lasso1,function(x) x$deviance)
sum(dev1["binomial",]>dev1["grid",])
auc1 <- sapply(lasso1,function(x) x$auc)
sum(auc1["binomial",]<auc1["grid",])
set.seed(1)
devtools::install_github("rauschenberger/cornet")
rm(list=ls(all.names=TRUE))
#devtools::install_github("rauschenberger/decline")
.source <- "C:/Users/armin.rauschenberger/Desktop/package/data"
.target <- "C:/Users/armin.rauschenberger/Desktop/package/decline/data"
project <- "ppmi" # "luxpark" or "ppmi"
if(project=="luxpark"){
load(file.path(.source,"luxpark_2018-12-04.RData"))
if(any(Y$visit0!=X$question113_113,na.rm=TRUE)){stop("Mismatch.")}
if(any(rownames(Y)!=rownames(Xs))){stop("Mismatch!")}
} else if(project=="ppmi"){
load(file.path(.source,"ppmi_2018-11-20.RData"))
if(any(Y[,"visit0"]!=X$"MOCA-MCATOT",na.rm=TRUE)){stop("Mismatch.")}
} else if(project=="trial"){
load(file.path(.source,"ppmi_trial_2019-11-01.RData"))
}
if(any(rownames(Y)!=rownames(X))){stop("Mismatch.")}
temp <- decline:::response(x=Y,type="average")
Y$sign <- temp$sign; Y$diff <- temp$diff
# y <- 1*(Y[,"visit1"] - Y[,"visit0"] < - 5) # alternative
# y <- 1*(Y[,"visit1"] > Y[,"visit0"]) # original (but wrong)
cond <- !is.na(Y$diff)
Y <- Y[cond,]; X <- X[cond,]
if(project=="trial"){
seq <- seq[cond,]
}
# Xs <- Xs[cond,] # selected set
X <- decline::curate_missing(X)
X <- decline::curate_hidden(X)
X <- decline::curate_levels(X)
X <- decline::curate_constant(X)
set.seed(1)
X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_random(X))
#X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_mean(X))
#X_imp <- VIM::kNN(data=X)[,1:ncol(x)/2]) # worse
#library(mice)
#X_imp <- mice::complete(data=mice::mice(Xs,m=5,maxit=5,method="pmm",seed=1),action="all")
rm(list=ls())
set.seed(1)
devtools::install_github("rauschenberger/cornet")
rm(list=ls(all.names=TRUE))
#devtools::install_github("rauschenberger/decline")
.source <- "C:/Users/armin.rauschenberger/Desktop/package/data"
.target <- "C:/Users/armin.rauschenberger/Desktop/package/decline/data"
project <- "ppmi" # "luxpark" or "ppmi"
if(project=="luxpark"){
load(file.path(.source,"luxpark_2018-12-04.RData"))
if(any(Y$visit0!=X$question113_113,na.rm=TRUE)){stop("Mismatch.")}
if(any(rownames(Y)!=rownames(Xs))){stop("Mismatch!")}
} else if(project=="ppmi"){
load(file.path(.source,"ppmi_2018-11-20.RData"))
if(any(Y[,"visit0"]!=X$"MOCA-MCATOT",na.rm=TRUE)){stop("Mismatch.")}
} else if(project=="trial"){
load(file.path(.source,"ppmi_trial_2019-11-01.RData"))
}
if(any(rownames(Y)!=rownames(X))){stop("Mismatch.")}
temp <- decline:::response(x=Y,type="average")
Y$sign <- temp$sign; Y$diff <- temp$diff
# y <- 1*(Y[,"visit1"] - Y[,"visit0"] < - 5) # alternative
# y <- 1*(Y[,"visit1"] > Y[,"visit0"]) # original (but wrong)
cond <- !is.na(Y$diff)
Y <- Y[cond,]; X <- X[cond,]
if(project=="trial"){
seq <- seq[cond,]
}
# Xs <- Xs[cond,] # selected set
X <- decline::curate_missing(X)
X <- decline::curate_hidden(X)
X <- decline::curate_levels(X)
X <- decline::curate_constant(X)
set.seed(1)
X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_random(X))
#X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_mean(X))
#X_imp <- VIM::kNN(data=X)[,1:ncol(x)/2]) # worse
#library(mice)
#X_imp <- mice::complete(data=mice::mice(Xs,m=5,maxit=5,method="pmm",seed=1),action="all")
load(file.path(.target,"temporary.RData"))
# number of improvements (lasso, cutoff -1)
dev1 <- sapply(lasso1,function(x) x$deviance)
sum(dev1["binomial",]>dev1["grid",])
auc1 <- sapply(lasso1,function(x) x$auc)
sum(auc1["binomial",]<auc1["grid",])
# AUC change
rowMeans(sapply(lasso1,function(x) x$auc))
rowMeans(sapply(ridge1,function(x) x$auc))
rowMeans(sapply(lasso0,function(x) x$auc))
# refit
x <- scale(decline::curate_dummies(as.data.frame(X_imp[[1]])))
fit <- cornet::cornet(y=Y$diff,cutoff=-1,X=x)
cornet:::plot.cornet(fit)
fit$pi.min
fit$sigma.min
rm(list=ls())
set.seed(1)
devtools::install_github("rauschenberger/cornet")
rm(list=ls(all.names=TRUE))
#devtools::install_github("rauschenberger/decline")
.source <- "C:/Users/armin.rauschenberger/Desktop/package/data"
.target <- "C:/Users/armin.rauschenberger/Desktop/package/decline/data"
project <- "ppmi" # "luxpark" or "ppmi"
if(project=="luxpark"){
load(file.path(.source,"luxpark_2018-12-04.RData"))
if(any(Y$visit0!=X$question113_113,na.rm=TRUE)){stop("Mismatch.")}
if(any(rownames(Y)!=rownames(Xs))){stop("Mismatch!")}
} else if(project=="ppmi"){
load(file.path(.source,"ppmi_2018-11-20.RData"))
if(any(Y[,"visit0"]!=X$"MOCA-MCATOT",na.rm=TRUE)){stop("Mismatch.")}
} else if(project=="trial"){
load(file.path(.source,"ppmi_trial_2019-11-01.RData"))
}
if(any(rownames(Y)!=rownames(X))){stop("Mismatch.")}
temp <- decline:::response(x=Y,type="average")
Y$sign <- temp$sign; Y$diff <- temp$diff
# y <- 1*(Y[,"visit1"] - Y[,"visit0"] < - 5) # alternative
# y <- 1*(Y[,"visit1"] > Y[,"visit0"]) # original (but wrong)
cond <- !is.na(Y$diff)
Y <- Y[cond,]; X <- X[cond,]
if(project=="trial"){
seq <- seq[cond,]
}
# Xs <- Xs[cond,] # selected set
X <- decline::curate_missing(X)
X <- decline::curate_hidden(X)
X <- decline::curate_levels(X)
X <- decline::curate_constant(X)
set.seed(1)
X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_random(X))
#X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_mean(X))
#X_imp <- VIM::kNN(data=X)[,1:ncol(x)/2]) # worse
#library(mice)
#X_imp <- mice::complete(data=mice::mice(Xs,m=5,maxit=5,method="pmm",seed=1),action="all")
load(file.path(.target,"temporary.RData"))
objects()
x <- scale(decline::curate_dummies(as.data.frame(X_imp[[1]])))
set.seed(1)
fit <- cornet::cornet(y=Y$diff,cutoff=-1,X=x)
save(lasso0,lasso1,ridge0,ridge1,fit,
file=file.path(.target,"temporary.RData"))
load(file.path(.target,"temporary.RData"))
# number of improvements (lasso, cutoff -1)
dev1 <- sapply(lasso1,function(x) x$deviance)
sum(dev1["binomial",]>dev1["grid",])
auc1 <- sapply(lasso1,function(x) x$auc)
sum(auc1["binomial",]<auc1["grid",])
# AUC change
rowMeans(sapply(lasso1,function(x) x$auc))
rowMeans(sapply(ridge1,function(x) x$auc))
rowMeans(sapply(lasso0,function(x) x$auc))
# refit
cornet:::plot.cornet(fit)
fit$pi.min
fit$sigma.min
X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
n <- 100
p <- 200
y <- stats::rnorm(n)
X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
n <- 100
p <- 200
y <- stats::rnorm(n)
X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
fit <- cornet::cornet(y,cutoff=0,X=X)
n <- 100
p <- 50
y <- stats::rnorm(n)
X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
fit <- cornet::cornet(y,cutoff=0,X=X)
n <- 100
p <- 50
y <- stats::rnorm(n)
X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
fit <- cornet::cornet(y,cutoff=0,X=X)
cornet:::plot.cornet(fit)
n <- 100
p <- 50
y <- stats::rnorm(n)
X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
fit <- cornet::cornet(y,cutoff=0,X=X)
cornet:::plot.cornet(fit)
# Replace simulation ...
set.seed(1)
n <- 100; p <- 50
y <- stats::rnorm(n)
X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
fit <- cornet::cornet(y,cutoff=0,X=X)
# ... by true values!
graphics::par(mar=c(4,4,0.5,0.5))
cornet:::plot.cornet(fit)
# Replace simulation ...
set.seed(0)
n <- 100; p <- 50
y <- stats::rnorm(n)
X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
fit <- cornet::cornet(y,cutoff=0,X=X)
# ... by true values!
graphics::par(mar=c(4,4,0.5,0.5))
cornet:::plot.cornet(fit)
?edgeR
?edge::calculateNormFactors
?edgeR::calculateNormFactors
edgeR::calcNormFactors()
?edgeR::calcNormFactors
rm(list=ls())
#--- generate toydata ----------------------------------------------------------
set.seed(1)
#toydata <- NULL
#save(toydata,file=file.path("C:/Users/armin.rauschenberger/Desktop/package/cornet/data/toydata.R"))
#--- compile package -----------------------------------------------------------
rm(list=ls())
name <- "cornet"
#load("D:/cornet/package/toydata.RData")
pkg <- "C:/Users/armin.rauschenberger/Desktop/cornet/cornet"
setwd(dir=pkg)
devtools::as.package(x=pkg,create=FALSE)
devtools::load_all(path=pkg)
#usethis::use_data(toydata,overwrite=TRUE)
devtools::document(pkg=pkg)
unlink(file.path(pkg,"vignettes","figure"),recursive=TRUE)
all <- dir(file.path(pkg,"vignettes"))
#delete <- "..."
#sapply(delete,function(x) file.remove(file.path(pkg,"vignettes",x)))
setwd(dir=pkg)
unlink(file.path(pkg,"docs"),recursive=TRUE)
pkgdown::build_site(pkg=pkg)
file.remove(file.path(pkg,".Rbuildignore"))
usethis::use_build_ignore(files=c("Readme.Rmd",".travis.yml","_pkgdown.yml","docs","cran-comments.md","appveyor.yml"))
devtools::check(pkg=pkg,quiet=FALSE,manual=TRUE)
devtools::install(pkg=pkg,upgrade=FALSE)
setwd(pkg)
system("git remote set-url origin https://rauschenberger:Eu57Rom!@github.com/rauschenberger/cornet.git")
system("git remote -v")
system("git add --all")
system("git commit -m \"automation\"")
system("git push origin master") # GitHub
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment