Merge pull request #85 from rsquaredacademy/develop

fix shiny app bug

Author: aravindhebbali

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: blorr
 Type: Package
 Title: Tools for Developing Binary Logistic Regression Models
-Version: 0.2.0.9000
+Version: 0.2.1
 Authors@R: person("Aravind", "Hebbali", email = "hebbali.aravind@gmail.com", role = c("aut", "cre"), 
     comment = c(ORCID = "0000-0001-9220-9669"))
 Description: Tools designed to make it easier for beginner and intermediate users to build and validate 
@@ -27,16 +27,26 @@ Imports:
     Rcpp,
     rlang,
     scales,
+    shiny,
     stats,
     tibble,
-    utils,
-    xplorerr
+    utils
 Suggests: 
     covr,
+    descriptr,
+    grid,
     ineq,
+    jsonlite, 
+    lubridate,
     knitr,
+    readr,
+    readxl,
     rmarkdown,
+    shinyBS,
+    shinythemes,
+    stringr,
     testthat,
+    tidyr,
     vdiffr
 License: MIT + file LICENSE
 URL: URL: https://blorr.rsquaredacademy.com/, https://github.com/rsquaredacademy/blorr

NEWS.md

@@ -1,3 +1,7 @@
+# blorr 0.2.1
+
+This is a patch release to fix bugs in the app.
+
 # blorr 0.2.0
 
 This is a minor release to fix bugs and for other enhancements.

R/blr-bivariate-analysis.R

@@ -39,14 +39,6 @@ blr_bivariate_analysis.default <- function(data, response, ...) {
   blr_check_data(data)
 
   data_name <- deparse(substitute(data))
-  k <- check_choice(quo_name(resp), choices = names(data))
-  
-  if (k != TRUE) {
-
-    cat("Uh oh...", crayon::bold$red(quo_name(resp)), "is not a column in", crayon::bold$blue(data_name), ". Please check the column names using: \n\n", crayon::bold$blue("* names()"), "\n", crayon::bold$blue("* colnames()"), "\n\n")
-
-    stop("", call. = FALSE)
-  }
 
   mdata <-
     data %>%
@@ -160,30 +152,12 @@ blr_segment <- function(data, response, predictor) UseMethod("blr_segment")
 blr_segment.default <- function(data, response, predictor) {
 
   blr_check_data(data)
-  # blr_check_varnames(data, response)
 
   resp <- enquo(response)
   pred <- enquo(predictor)
 
   data_name <- deparse(substitute(data))
-  k <- check_choice(quo_name(resp), choices = names(data))
 
-  if (k != TRUE) {
-
-    cat("Uh oh...", crayon::bold$red(quo_name(resp)), "is not a column in", crayon::bold$blue(data_name), ". Please check the column names using: \n\n", crayon::bold$blue("* names()"), "\n", crayon::bold$blue("* colnames()"), "\n\n")
-
-    stop("", call. = FALSE)
-  }
-
-  k2 <- check_choice(quo_name(pred), choices = names(data))
-  
-  if (k2 != TRUE) {
-
-    cat("Uh oh...", crayon::bold$red(quo_name(pred)), "is not a column in", crayon::bold$blue(data_name), ". Please check the column names using: \n\n", crayon::bold$blue("* names()"), "\n", crayon::bold$blue("* colnames()"), "\n\n")
-
-    stop("", call. = FALSE)
-  }
-
   segment_data <-
     data %>%
     select(!! pred, !! resp) %>%
@@ -232,44 +206,13 @@ blr_segment_twoway <- function(data, response, variable_1, variable_2) UseMethod
 blr_segment_twoway.default <- function(data, response, variable_1, variable_2) {
 
   blr_check_data(data)
-  # blr_check_varnames(data, response)
-  # blr_check_varnames(data, variable_1)
-  # blr_check_varnames(data, variable_2)
-
+  
   resp  <- enquo(response)
   var_1 <- enquo(variable_1)
   var_2 <- enquo(variable_2)
 
   data_name <- deparse(substitute(data))
-  k <- check_choice(quo_name(resp), choices = names(data))
 
-  if (k != TRUE) {
-
-    cat("Uh oh...", crayon::bold$red(quo_name(resp)), "is not a column in", crayon::bold$blue(data_name), ". Please check the column names using: \n\n", crayon::bold$blue("* names()"), "\n", crayon::bold$blue("* colnames()"), "\n\n")
-
-    stop("", call. = FALSE)
-  }
-
-
-  k2 <- check_choice(quo_name(var_1), choices = names(data))
-  
-  if (k2 != TRUE) {
-
-    cat("Uh oh...", crayon::bold$red(quo_name(var_1)), "is not a column in", crayon::bold$blue(data_name), ". Please check the column names using: \n\n", crayon::bold$blue("* names()"), "\n", crayon::bold$blue("* colnames()"), "\n\n")
-
-    stop("", call. = FALSE)
-  }
-
-  k3 <- check_choice(quo_name(var_2), choices = names(data))
-  
-  if (k3 != TRUE) {
-
-    cat("Uh oh...", crayon::bold$red(quo_name(var_2)), "is not a column in", crayon::bold$blue(data_name), ". Please check the column names using: \n\n", crayon::bold$blue("* names()"), "\n", crayon::bold$blue("* colnames()"), "\n\n")
-
-    stop("", call. = FALSE)
-  }
-
-
   n     <- nrow(data)
 
   dat <-

R/blr-gains-table.R

@@ -25,7 +25,7 @@
 #' Oxford,  Oxford  Uni-versity Press.
 #'
 #' Sobehart  J,  Keenan  S,  Stein  R  (2000):  Benchmarking  Quantitative  Default  Risk  Models:
-#' A  Valid-ation Methodology, Moody’s Investors Service.
+#' A  Validation Methodology, Moody’s Investors Service.
 #'
 #' @examples
 #' model <- glm(honcomp ~ female + read + science, data = hsb2,
@@ -128,11 +128,9 @@ plot.blr_gains_table <- function(x, title = "Lift Chart", xaxis_title = "% Popul
 #' @param ks_line_color Color of the line indicating maximum KS statistic.
 #'
 #' @references
-#' Tjur, T. (2009), "Coefficients of Determination in Logistic Regression Models — A New Proposal:
-#' The Coefficient of Discrimination," The American Statistician, 63(4), 366-372.
+#' \url{https://doi.org/10.1198/tast.2009.08210}
 #'
-#' Horn, S. D. (1977), Goodness-of-fit tests for discrete data: a review and an application to a
-#' health impairment scale, Biometrics, 33, 237–247.
+#' \url{https://www.ncbi.nlm.nih.gov/pubmed/843576}
 #'
 #' @examples
 #' model <- glm(honcomp ~ female + read + science, data = hsb2,

R/blr-hosmer-lemeshow-test.R

@@ -32,8 +32,8 @@ blr_test_hosmer_lemeshow.default <- function(model, data = NULL) {
   blr_check_model(model)
 
   if (is.null(data)) {
+    resp <- model$y
     data <- eval(model$call$data)
-    resp <- model$y 
   } else {
     namu <-
       model %>%
@@ -42,10 +42,8 @@ blr_test_hosmer_lemeshow.default <- function(model, data = NULL) {
 
     blr_check_data(data)
 
-    resp <- 
-      data %>% 
-      pull(!! namu) %>%
-      as.numeric()
+    resp_temp <- pull(data, !! namu)
+    resp <- as.numeric(levels(resp_temp))[resp_temp]
   }
 
   hoslem_data <- hoslem_data_prep(model, data, resp)

R/blr-launch-app.R

@@ -8,9 +8,6 @@
 #'
 blr_launch_app <- function() {
 
-	rlang::inform("`blr_launch_app()` has been soft-deprecated and will be removed in the next release. In future, to launch the app, run the below code:\n 
-	- install.packages('xplorerr')\n - xplorerr::app_logistic_regression()\n")
-
 	check_suggests('descriptr')
 	check_suggests('jsonlite')
 	check_suggests('haven')
@@ -23,7 +20,7 @@ blr_launch_app <- function() {
 	check_suggests('stringr')
 	check_suggests('tidyr')
 
-	xplorerr::app_logistic_regression()
+	shiny::runApp(appDir = system.file("application", package = "blorr"))
 
 }
 

R/blr-linktest.R

@@ -9,9 +9,9 @@
 #' @references
 #' Pregibon,  D.  1979.  Data  analytic  methods  for  generalized  linear  models.  PhD  diss.,  University  of  Toronto.
 #' 
-#' Pregibon,  D.  1980.  Goodness  of  link  tests  for  generalized  linear  models. Applied  Statistics 29:  15–24.
+#' Pregibon,  D.  1980.  Goodness  of  link  tests  for  generalized  linear  models. 
 #' 
-#' Tukey,  J.  W.  1949.  One  degree  of  freedom  for  non-additivity. Biometrics 5:  232–242
+#' Tukey,  J.  W.  1949.  One  degree  of  freedom  for  non-additivity. 
 #'
 #' @examples
 #'

R/blr-lorenz-curve.R

@@ -16,8 +16,7 @@
 #' Müller M, Rönz B (2000): Credit Scoring using Semiparametric Methods. In: Franke J, Härdle W, Stahl G (Eds.):
 #' Measuring Risk in Complex Stochastic Systems. New York, Springer-Verlag.
 #'
-#' Kočenda  E,  Vojtek  M  (2011):  Default  Predictors  in  Retail  Credit  Scoring:  Evidence  from  Czech
-#' Banking Data. Forthcoming in: Emerging Markets Finance and Trade.
+#' \url{https://doi.org/10.2753/REE1540-496X470605}
 #'
 #' @examples
 #' model <- glm(honcomp ~ female + read + science, data = hsb2,

R/blr-model-fit-stats.R

@@ -120,8 +120,7 @@ model_bic <- function(model) {
 #' @return McFadden's r-squared.
 #' 
 #' @references
-#' McFadden, D. (1974) “Conditional logit analysis of qualitative choice behavior.” 
-#' Pp. 105-142 in P. Zarembka (ed.), Frontiers in Econometrics. Academic Press.
+#' \url{https://eml.berkeley.edu/reprints/mcfadden/zarembka.pdf}
 #'
 #' @examples
 #' model <- glm(honcomp ~ female + read + science, data = hsb2,
@@ -152,8 +151,7 @@ blr_rsq_mcfadden <- function(model) {
 #' @return McFadden's adjusted r-squared.
 #' 
 #' @references
-#' McFadden, D. (1974) “Conditional logit analysis of qualitative choice behavior.” 
-#' Pp. 105-142 in P. Zarembka (ed.), Frontiers in Econometrics. Academic Press.
+#' \url{https://eml.berkeley.edu/reprints/mcfadden/zarembka.pdf}
 #'
 #' @examples
 #' model <- glm(honcomp ~ female + read + science, data = hsb2,
@@ -218,7 +216,7 @@ blr_rsq_cox_snell <- function(model) {
 #' 
 #' Maddala, G. S. (1983). Limited dependent and qualitative variables in economics. New York: Cambridge Press.
 #' 
-#' Nagelkerke, N. (1991). A note on a general definition of the coefficient of determination. Biometrika, 78, 691–692. 
+#' Nagelkerke, N. (1991). A note on a general definition of the coefficient of determination. 
 #'
 #' @examples
 #' model <- glm(honcomp ~ female + read + science, data = hsb2,

R/blr-pairs.R

@@ -7,11 +7,9 @@
 #' @return A tibble.
 #' 
 #' @references
-#' Nelsen  RB  (1998):  Concordance  and  Gini’s  measure  of  association. Journal  of  Nonparametric  
-#' Statistics, 9(3):227–238. 
+#' \url{https://doi.org/10.1080/10485259808832744}
 #' 
-#' Newson  R  (2006):  Confidence  intervals  for  rank  statistics:  Somers'  D  and  extensions.  
-#' The  Stata Journal, 6(3):309–334. 
+#' \url{https://doi.org/10.1177/1536867X0600600302}
 #'
 #' @examples
 #' model <- glm(honcomp ~ female + read + science, data = hsb2,