update renv, added support for two classes (partial, add dots doesn't work yet)

Author: sepro

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: loreplotr
 Type: Package
 Title: Draw logistic regression plots in R (Title Case)
-Version: 0.2.1
+Version: 0.2.2
 Author: Sebastian Proost
 Maintainer: Sebastian Proost <[email protected]>
 Description: More about what it does (maybe more than one line)
@@ -10,7 +10,7 @@ License: file LICENSE
 Encoding: UTF-8
 LazyData: true
 Imports: ggplot2, nnet, tidyr, magrittr, dplyr, effects
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Suggests: 
     testthat (>= 3.0.0)
 Config/testthat/edition: 3

NAMESPACE

@@ -11,6 +11,8 @@ import(tidyr)
 importFrom(dplyr,mutate)
 importFrom(magrittr,"%>%")
 importFrom(stats,anova)
+importFrom(stats,binomial)
+importFrom(stats,glm)
 importFrom(stats,predict)
 importFrom(stats,reformulate)
 importFrom(stats,runif)

R/loreplotr.R

@@ -53,7 +53,7 @@ get_group_dots_data <- function(dots_data, i, groups) {
 #'
 #' @param df The input data
 #' @param x  Continuous variable to be shown on the x-axis
-#' @param y  Categorical variable, predicated probabilities shown on y-axis
+#' @param y  Categorical variable, predicated probabilities shown on y-axis (if there are only two classes they need to be 0 and 1 !)
 #' @param draw_dots Show a dot in the plot for eachs sample (default=TRUE)
 #' @param dots_shape Shape of the dots (default=21)
 #' @param dots_fill Fill color of the dots (default="white")
@@ -67,6 +67,8 @@ get_group_dots_data <- function(dots_data, i, groups) {
 #' @import dplyr
 #' @importFrom magrittr %>%
 #' @importFrom stats anova
+#' @importFrom stats glm
+#' @importFrom stats binomial
 #' @import tidyr
 #' @importFrom stats predict reformulate
 #' @export
@@ -75,19 +77,37 @@ plot_area <- function(df, x, y, draw_dots=TRUE, dots_shape=21, dots_fill="white"
   wdf = df %>% select(c({{x}}, {{y}}))
   .GlobalEnv$wdf = df %>% select(c({{x}}, {{y}}))
 
-  # Fit multinomial and generate data for areas
+  # Fit multinomial and generate data for areas (use glm for binary, multinom for > 2 classes)
   formula = reformulate(x, response = y)
-  mnom_model = multinom(formula, data=wdf)
+
+  num_classes <- length(unique(wdf[[y]]))
+
+  if (num_classes > 2) {
+    mnom_model <- multinom(formula, data = wdf)
+    predicted_probabilities = Effect(x, mnom_model, xlevels=300)
+    probabilities_df = data.frame(predicted_probabilities$x, predicted_probabilities$prob)
+  } else {
+    wdf[[y]] = as.numeric(wdf[[y]])
+    mnom_model <- glm(formula, family = binomial, data = wdf)
+
+    # Generate predicted probabilities manually for binary logistic regression
+    x_seq <- seq(min(wdf[[x]]), max(wdf[[x]]), length.out = 300)
+    new_data <- data.frame(x_seq)
+    colnames(new_data) <- x
+    probabilities <- predict(mnom_model, newdata = new_data, type = "response")
+    probabilities_df <- data.frame(x_seq, prob_0 = 1 - probabilities, prob_1 = probabilities)
+    colnames(probabilities_df)[1] <- x
+  }
 
   print(summary(mnom_model))
 
-  null_formula = reformulate("1", response = y)
-  null_model = multinom(null_formula, data=wdf)
+  if (num_classes > 2) {
+    null_formula <- reformulate("1", response = y)
+    null_model <- multinom(null_formula, data = wdf)
+    print(anova(mnom_model, null_model))
+  }
 
-  print(anova(mnom_model, null_model))
 
-  predicted_probabilities = Effect(x, mnom_model, xlevels=300)
-  probabilities_df = data.frame(predicted_probabilities$x, predicted_probabilities$prob)
 
   melt_data = pivot_longer(probabilities_df, -{{x}}, names_to = y, values_to = "value")
   melt_data[[y]] =  gsub('prob.', '', melt_data[[y]])
@@ -101,12 +121,11 @@ plot_area <- function(df, x, y, draw_dots=TRUE, dots_shape=21, dots_fill="white"
       axis.title.y = element_blank(),
     )
 
-  if (draw_dots) {
+  if (draw_dots && num_classes > 2) {
     groups = unique(melt_data[[y]])
 
     dots_data <- as.data.frame(cbind(df[[y]], df[[x]], predict(mnom_model, newdata = df[x], "probs")))
 
-
     for (i in 1:length(groups)) {
       group_dots_data = get_group_dots_data(dots_data, i, groups)
 

README.md

@@ -88,6 +88,30 @@ t <- t + scale_fill_manual(values = c("#DC9362", "#6BE19F", "#A373E5"))
 t
 ```
 
+Support for two classes is now partially implemented, though the classes need to be converted to 0 and 1 for the plot to work! (Note that dots currently aren't show when using two classes)
+
+```R
+library(dplyr)
+library(ggplot2)
+library(loreplotr)
+
+data("mtcars")
+
+mtcars$cyl <- paste("cyl", mtcars$cyl, sep="_")
+
+mtcars$cyl <- gsub("cyl_4", 0, mtcars$cyl)
+mtcars$cyl <- gsub("cyl_6", 0, mtcars$cyl)
+mtcars$cyl <- gsub("cyl_8", 1, mtcars$cyl)
+
+mtcars$cyl <- as.numeric(mtcars$cyl)
+
+t <- mtcars %>% loreplotr("mpg", "cyl")
+t
+
+t <- t + scale_fill_manual(values = c("#DC9362", "#6BE19F"))
+t
+```
+
 ![Example loreplot using mtcars dataset and custom dots](./docs/img/loreplot_custom_dots.png)
 
 ## Troubleshooting/FAQ

example.R

@@ -6,6 +6,12 @@ data("mtcars")
 
 mtcars$cyl <- paste("cyl", mtcars$cyl, sep="_")
 
+# mtcars$cyl <- gsub("cyl_4", 0, mtcars$cyl)
+# mtcars$cyl <- gsub("cyl_6", 0, mtcars$cyl)
+# mtcars$cyl <- gsub("cyl_8", 1, mtcars$cyl)
+#
+# mtcars$cyl <- as.numeric(mtcars$cyl)
+
 t <- mtcars %>% loreplotr("mpg", "cyl", dots_colour="black", dots_size=2, dots_alpha = 1, dots_shape=3)
 t
 

loreplotr.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: 7608749e-a747-44bd-88d7-c74ac3e301ba
 
 RestoreWorkspace: Default
 SaveWorkspace: Default