diff --git a/.DS_Store b/.DS_Store deleted file mode 100644 index 40d2784..0000000 Binary files a/.DS_Store and /dev/null differ diff --git a/.Rbuildignore b/.Rbuildignore deleted file mode 100644 index 8503423..0000000 --- a/.Rbuildignore +++ /dev/null @@ -1,6 +0,0 @@ -^.*\.Rproj$ -^\.Rproj\.user$ -^\.travis\.yml$ -^cran-comments\.md$ -^README\.Rmd$ -^README-.*\.png$ diff --git a/.Rhistory b/.Rhistory deleted file mode 100644 index 5030770..0000000 --- a/.Rhistory +++ /dev/null @@ -1,279 +0,0 @@ -document() -library(devtools) -document() -document() -document() -document() -document() -document() -document() -document() -document() -document() -document() -document() -check() -document() -check() -check() -?message -?message -mean.numeric <- function(x, ...) sum(x) / length(x) -mean(rnorm(10)) -mean.numeric <- function(x, ...) (sum(x)+100) / length(x) -mean(rnorm(10)) -mean.numeric <- function(x, ...) 20 -mean(rnorm(10)) -mean.numeric <- function(x, ...) 20 -mean(rnorm(10)) -check() -check() -check() -document() -document() -document() -document() -document() -document() -check() -devtools::use_rcpp() -document() -check() -document() -check() -document() -check() -document() -check() -document() -document() -check() -document() -check() -document() -check() -document() -check() -library(TVsMiss) -library(TVsMiss) -document() -check() -TVsMiss <- function(x,y,use.penalty=T,refit=F, -penalty=c("lasso", "MCP", "SCAD"), method=c("CV", "BIC","sBIC","sVS","sEST","Fleiss","BIChigh","BICultrahigh"), -lambda=NULL,fold=5,cv.ind=NULL,repeat_b=20,alpha_n=0.1){ -penalty <- match.arg(penalty) -method <- match.arg(method) -this.call = match.call() -if (class(x) != "matrix") { -tmp <- try(x <- model.matrix(~0+., data=x), silent=TRUE) -if (class(tmp)[1] == "try-error") stop("x must be a matrix or able to be coerced to a matrix") -} -if (storage.mode(x)=="integer") storage.mode(x) <- "double" -if (class(y) != "numeric") { -tmp <- try(y <- as.numeric(y), silent=TRUE) -if (class(tmp)[1] == "try-error") stop("y must numeric or able to be coerced to numeric") -} -if (length(y) != nrow(x)) stop("x and y do not have the same number of observations") -#step 1: remove missing -colnames(x) <- if (is.null(colnames(x))) paste("V",1:ncol(x),sep="") else colnames(x) -data <- cbind(y,x) -complete_idx <- c(1:length(y))[complete.cases(data)] -y_complete <- y[complete_idx] -x_complete <- x[complete_idx,] -#generate logistic data -sample_no_missing <- cbind(y_complete,x_complete) -logistic_sample <- logistic_generator(sample_no_missing) -if(use.penalty){ -if(is.null(cv.ind)){ -# check fold is in the correct range -if(fold<2 | fold>nrow(sample_no_missing)) stop("fold should be greater than 1 and less than the rows in the complete data(after deleting missing)") -cv.ind <- ceiling(sample(1:nrow(sample_no_missing))/(nrow(sample_no_missing)+sqrt(.Machine$double.eps))*fold) -}else{ -if(length(cv.ind) != nrow(sample_no_missing) | max(cv.ind) > nrow(sample_no_missing)) stop("cv.ind is not match to the complete data") -} -sample_no_missing_list <- list() -for(i in 1:max(cv.ind)){ -sample_no_missing_list[[i]] <- sample_no_missing[cv.ind == i,] -} -# logistic_list_estimation use (k-1) fold data to generate logistic dataset and estimate parameter -# logistic_list_verification use 1 fold data to genete logistic dataset and calculate log-likelihood -#if (method %in% c("CV", )) -logistic_list_estimation <- cv_logistic_prepare(complete_data=sample_no_missing, cv.ind=cv.ind) -# logistic_list_verification <- lapply(sample_no_missing_list, logistic_generator) -#step2 use penatly to estimate -current_model <- model_est_path(logistic_sample=logistic_sample,lambda=lambda,penalty=penalty) -beta_matrix <- t(as.matrix(coef(current_model)))[,-1] # remove intercept 0 -lambda <- current_model$lambda -#step3 variable selections -if(method == "CV"){ -begin_time <- proc.time() -selection_res <- cv_sel(logistic_list=logistic_list_estimation, complete_data_list=sample_no_missing_list, -cv.fold=fold, cv.ind=cv.ind, penalty=penalty, lambda=lambda) -selection_idx <- selection_res$lambda_idx -selection_lambda <- lambda[selection_res$lambda_idx] -selection_path <- selection_res$selection_path -selection_cv.ind <- selection_res$cv.ind -selection_beta <- beta_matrix[selection_idx,] -final_time <- proc.time() - begin_time -}else if(method == "BIC"){ -begin_time <- proc.time() -selection_res <- BIC_log_cal(complete_dataset=sample_no_missing,beta_matrix=beta_matrix) -selection_idx <- selection_res$lambda_idx -selection_lambda <- lambda[selection_res$lambda_idx] -selection_path <- selection_res$selection_path -selection_cv.ind <- NULL -selection_beta <- beta_matrix[selection_idx,] -final_time <- proc.time() - begin_time -}else if(method == "sBIC"){ -begin_time <- proc.time() -selection_res <- sBIC(complete_data=sample_no_missing, cv.fold=fold, cv.ind=cv.ind, -penalty=penalty, lambda=lambda) -selection_idx <- selection_res$lambda_idx -selection_lambda <- lambda[selection_res$lambda_idx] -selection_path <- selection_res$selection_path -selection_cv.ind <- selection_res$cv.ind -selection_beta <- beta_matrix[selection_idx,] -final_time <- proc.time() - begin_time -}else if(method == "sVS"){ -if(fold == 2){ -begin_time <- proc.time() -selection_res <- VSS(complete_data=sample_no_missing,lambda=lambda,repeat_b=repeat_b,alpha_n=alpha_n,penalty=penalty) -selection_idx <- which(lambda == selection_res$selection_lambda_value) -selection_lambda <- selection_res$selection_lambda_value -selection_path <- selection_res$selection_path -selection_cv.ind <- NULL -selection_beta <- beta_matrix[selection_idx,] -final_time <- proc.time() - begin_time -}else{ -begin_time <- proc.time() -selection_res <- fleiss(complete_data=sample_no_missing, cv.fold=fold, cv.ind=cv.ind, -penalty=penalty, lambda=lambda, alpha_n=alpha_n) -selection_idx <- which(lambda == selection_res$selection_lambda_value) -selection_lambda <- selection_res$selection_lambda_value -selection_path <- selection_res$selection_path -selection_cv.ind <- selection_res$cv.ind -selection_beta <- beta_matrix[selection_idx,] -final_time <- proc.time() - begin_time -} -}else if(method == "sEST"){ -begin_time <- proc.time() -selection_res <- sEST(complete_data=sample_no_missing, cv.fold=fold, cv.ind=cv.ind, -penalty=penalty, lambda=lambda) -selection_idx <- selection_res$lambda_idx -selection_lambda <- lambda[selection_res$lambda_idx] -selection_path <- selection_res$selection_path -selection_cv.ind <- selection_res$cv.ind -selection_beta <- beta_matrix[selection_idx,] -final_time <- proc.time() - begin_time -}else if(method == "BIChigh"){ -begin_time <- proc.time() -selection_res <- BIC_high(complete_dataset=sample_no_missing,beta_matrix=beta_matrix) -selection_idx <- selection_res$lambda_idx -selection_lambda <- lambda[selection_res$lambda_idx] -selection_path <- selection_res$selection_path -selection_cv.ind <- NULL -selection_beta <- beta_matrix[selection_idx,] -final_time <- proc.time() - begin_time -}else if(method == "BICultrahigh"){ -begin_time <- proc.time() -selection_res <- BIC_ultrahigh(complete_dataset=sample_no_missing,beta_matrix=beta_matrix) -selection_idx <- selection_res$lambda_idx -selection_lambda <- lambda[selection_res$lambda_idx] -selection_path <- selection_res$selection_path -selection_cv.ind <- NULL -selection_beta <- beta_matrix[selection_idx,] -final_time <- proc.time() - begin_time -} -}else{ -begin_time <- proc.time() -glm_model <- glm(logistic_sample[,1]~-1+logistic_sample[,-1], family = binomial(link = "logit")) -current_model = glm_model -beta_matrix = NULL -lambda = NULL -cv.ind = NULL -selection_idx = NULL -selection_lambda = NULL -selection_path = NULL -selection_cv.ind = NULL -selection_beta = current_model$coefficients -names(selection_beta) <- colnames(logistic_sample)[-1] -final_time <- proc.time() - begin_time -} -deviance.ratio = 1 + loglikelihood(c(0,selection_beta),sample_no_missing)/log(2) -#refit -if(refit & use.penalty){ -if(sum(selection_beta != 0) == 0){ -refit_beta = selection_beta -}else{ -refit_model <- glm(logistic_sample[,1]~-1+logistic_sample[,-1][,which(selection_beta != 0)], family = binomial(link = "logit")) -refit_beta <- rep(0,ncol(logistic_sample)-1) -refit_beta[which(selection_beta != 0)] <- refit_model$coefficients -names(refit_beta) <- colnames(logistic_sample)[-1] -} -}else{ -refit_beta=NULL -} -res <- list(ls=logistic_sample,c_idx=complete_idx,model=current_model, -beta_matrix=beta_matrix,lambda=lambda, cv.ind=cv.ind, fold=fold, -selection_idx = selection_idx, selection_lambda = selection_lambda, -selection_path = selection_path, selection_cv.ind = selection_cv.ind, -selection_beta = selection_beta, -refit_beta = refit_beta, -null.deviance = 2*log(2), -deviance.ratio=deviance.ratio, -call = this.call, -running_time = final_time) -return(res) -} -document() -document() -check() -document() -check() -check() -?.Call -library(TVsMiss) -library(TVsMiss) -document() -check() -library(TVsMiss) -document() -document() -check() -document() -document() -check() -document() -check() -document() -document() -check() -R_RegisterCCallable() -document() -document() -check() -document() -library(devtools) -document() -check() -library(TVsMiss) -document() -check() -document() -document() -document() -document() -check() -tools::package_native_routine_registration_skeleton(".") -document() -document() -document() -library(TVsMiss) -library(ncvreg) -?ncvreg -library(glmnet) -?glmnet() -library(devtools) -check() -library(devtools) -check() diff --git a/.Rproj.user/37231BE/console06/6901CFDD b/.Rproj.user/37231BE/console06/6901CFDD index f9ddbf0..f437c0c 100644 --- a/.Rproj.user/37231BE/console06/6901CFDD +++ b/.Rproj.user/37231BE/console06/6901CFDD @@ -637,4 +637,38 @@ drwxr-xr-x@ 21 yangyang staff 672B Mar 5 18:59 R/ drwxr-xr-x@ 3 yangyang staff 96B Mar 5 06:12 tests/ -rw-r--r--@ 1 yangyang staff 8.5K Feb 26 18:26 .Rhistory drwxr-xr-x@ 4 yangyang staff 128B Feb 4 15:23 .Rproj.user/ -]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ ls -altgit push -u origin mastercommit -m "correct typo"add . \ No newline at end of file +]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ ls -altgit push -u origin mastercommit -m "correct typo"add . +]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ git add .ls -altgit push -u origin mastercommit -m "correct typo"""""""""""""c"l"e"a"n" "u"p" +[master 039b3a0] clean up + 5 files changed, 49 insertions(+), 1 deletion(-) +]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ git sttaaatus +On branch master +Your branch is ahead of 'origin/master' by 1 commit. + (use "git push" to publish your local commits) + +Changes not staged for commit: + (use "git add ..." to update what will be committed) + (use "git checkout -- ..." to discard changes in working directory) + + modified: .Rproj.user/37231BE/console06/6901CFDD + +no changes added to commit (use "git add" and/or "git commit -a") +]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ git statuscommit -m "clean up"add .ls -altgit push -u origin master +Counting objects: 14, done. +Delta compression using up to 8 threads. +Compressing objects: 7% (1/14) Compressing objects: 14% (2/14) Compressing objects: 21% (3/14) Compressing objects: 28% (4/14) Compressing objects: 35% (5/14) Compressing objects: 42% (6/14) Compressing objects: 50% (7/14) Compressing objects: 57% (8/14) Compressing objects: 64% (9/14) Compressing objects: 71% (10/14) Compressing objects: 78% (11/14) Compressing objects: 85% (12/14) Compressing objects: 92% (13/14) Compressing objects: 100% (14/14) Compressing objects: 100% (14/14), done. +Writing objects: 7% (1/14) Writing objects: 14% (2/14) Writing objects: 21% (3/14) Writing objects: 28% (4/14) Writing objects: 35% (5/14) Writing objects: 42% (6/14) Writing objects: 50% (7/14) Writing objects: 57% (8/14) Writing objects: 64% (9/14) Writing objects: 71% (10/14) Writing objects: 78% (11/14) Writing objects: 85% (12/14) Writing objects: 92% (13/14) Writing objects: 100% (14/14) Writing objects: 100% (14/14), 1.85 KiB | 45.00 KiB/s, done. +Total 14 (delta 7), reused 0 (delta 0) +remote: Resolving deltas: 0% (0/7)  remote: Resolving deltas: 14% (1/7)  remote: Resolving deltas: 28% (2/7)  remote: Resolving deltas: 42% (3/7)  remote: Resolving deltas: 57% (4/7)  remote: Resolving deltas: 71% (5/7)  remote: Resolving deltas: 85% (6/7)  remote: Resolving deltas: 100% (7/7)  remote: Resolving deltas: 100% (7/7), completed with 7 local objects. +To https://github.com/yang0117/TVsMiss.git + 59ae5ec..039b3a0 master -> master +Branch master set up to track remote branch master from origin. +]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ git removem .Rhistory  +rm '.Rhistory' +]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ git rm .DS_Store  +rm '.DS_Store' +]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ git rm --cached file1.txt.Rbuildignore  +rm '.Rbuildignore' +]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ git rm --cached .RbuildignoreTVsMiss.Rproj  +rm 'TVsMiss.Rproj' +]0;~/Dropbox/04.Projects/package/TVsMissyangyang@Yangs-MacBook-Pro:~/Dropbox/04.Projects/package/TVsMiss$ git rm --cached TVsMiss.Rproj.Rbuildignore.DS_StoreRhistorypush -u origin masterstatuscommit -m "clean up"add . \ No newline at end of file diff --git a/TVsMiss.Rproj b/TVsMiss.Rproj deleted file mode 100644 index 398aa14..0000000 --- a/TVsMiss.Rproj +++ /dev/null @@ -1,20 +0,0 @@ -Version: 1.0 - -RestoreWorkspace: Default -SaveWorkspace: Default -AlwaysSaveHistory: Default - -EnableCodeIndexing: Yes -UseSpacesForTab: Yes -NumSpacesForTab: 2 -Encoding: UTF-8 - -RnwWeave: knitr -LaTeX: pdfLaTeX - -AutoAppendNewline: Yes -StripTrailingWhitespace: Yes - -BuildType: Package -PackageUseDevtools: Yes -PackageInstallArgs: --no-multiarch --with-keep.source