Skip to content

Commit

Permalink
added easyalluvial. for condensation variable there is a bug self$dat…
Browse files Browse the repository at this point in the history 
…a is selected as other variables
  • Loading branch information
@sbalci
sbalci committed May 23, 2020
1 parent b92489b commit 1c226e1
Show file tree
Hide file tree
Showing 20 changed files with 377 additions and 82 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,8 @@ Depends:
R (>= 3.6.0)
Imports:
jmvcore,
R6
R6,
magrittr
Remotes:
ddsjoberg/gtsummary,
ndphillips/FFTrees,
Expand Down Expand Up @@ -56,7 +57,6 @@ Suggests:
explore,
rpart,
rpart.plot,
magrittr,
plotROC,
arsenal,
easyalluvial,
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,4 +25,5 @@ export(vartree)
import(jmvcore)
importFrom(R6,R6Class)
importFrom(jmvcore,toNumeric)
importFrom(magrittr,"%>%")
importFrom(utils,data)
92 changes: 55 additions & 37 deletions R/alluvial.b.R
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,10 @@
#' @title Alluvial Plot
#' @return Alluvial Plot
#' @importFrom R6 R6Class
#' @import jmvcore
#' @importFrom magrittr %>%
#'


# This file is a generated template, your changes will not be overwritten

Expand Down Expand Up @@ -36,15 +43,6 @@ alluvialClass <- if (requireNamespace('jmvcore')) R6::R6Class(












# #Errors ----
#
# if (is.null(self$options$vars) )
Expand Down Expand Up @@ -106,29 +104,6 @@ alluvialClass <- if (requireNamespace('jmvcore')) R6::R6Class(
# html$setContent(plothtml)

























}

}
Expand Down Expand Up @@ -161,20 +136,20 @@ alluvialClass <- if (requireNamespace('jmvcore')) R6::R6Class(

verbose <- FALSE

verb <- self$options$verb

if (isTRUE(verb)) verbose <- TRUE

# fill_by ----

jmvcore::composeTerm(self$options$fill)

self$options$fill
fill <- jmvcore::composeTerm(self$options$fill)


#bin

bin <- self$options$bin

if (bin = "default") bin <- 'c("LL", "ML", "M", "MH", "HH")'
if (bin == "default") bin <- c("LL", "ML", "M", "MH", "HH")

# Exclude NA ----

Expand Down Expand Up @@ -223,5 +198,48 @@ alluvialClass <- if (requireNamespace('jmvcore')) R6::R6Class(
print(plot)
TRUE

})
}


,

.plot2 = function(image, ...) {
# the plot function ----

#Errors ----

if (is.null(self$options$condensationvar) )
return()

if (nrow(self$data) == 0)
stop('Data contains no (complete) rows')

# Prepare Data ----

condvarName <- self$options$condensationvar

condvarName <- jmvcore::composeTerm(components = condvarName)



plot2 <- self$data %>%
easyalluvial::plot_condensation(df = .,
first = .data[[condvarName]])


# Print Plot ----

print(plot2)
TRUE




}





)
)
92 changes: 83 additions & 9 deletions R/alluvial.h.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,12 @@ alluvialOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
public = list(
initialize = function(
vars = NULL,
condensationvar = NULL,
excl = TRUE,
marg = FALSE, ...) {
marg = FALSE,
verb = FALSE,
fill = "first_variable",
bin = "default", ...) {

super$initialize(
package='ClinicoPath',
Expand All @@ -19,6 +23,9 @@ alluvialOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
private$..vars <- jmvcore::OptionVariables$new(
"vars",
vars)
private$..condensationvar <- jmvcore::OptionVariable$new(
"condensationvar",
condensationvar)
private$..excl <- jmvcore::OptionBool$new(
"excl",
excl,
Expand All @@ -27,26 +34,62 @@ alluvialOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
"marg",
marg,
default=FALSE)
private$..verb <- jmvcore::OptionBool$new(
"verb",
verb,
default=FALSE)
private$..fill <- jmvcore::OptionList$new(
"fill",
fill,
options=list(
"first_variable",
"last_variable",
"all_flows",
"values"),
default="first_variable")
private$..bin <- jmvcore::OptionList$new(
"bin",
bin,
options=list(
"default",
"mean",
"median",
"min_max",
"cuts"),
default="default")

self$.addOption(private$..vars)
self$.addOption(private$..condensationvar)
self$.addOption(private$..excl)
self$.addOption(private$..marg)
self$.addOption(private$..verb)
self$.addOption(private$..fill)
self$.addOption(private$..bin)
}),
active = list(
vars = function() private$..vars$value,
condensationvar = function() private$..condensationvar$value,
excl = function() private$..excl$value,
marg = function() private$..marg$value),
marg = function() private$..marg$value,
verb = function() private$..verb$value,
fill = function() private$..fill$value,
bin = function() private$..bin$value),
private = list(
..vars = NA,
..condensationvar = NA,
..excl = NA,
..marg = NA)
..marg = NA,
..verb = NA,
..fill = NA,
..bin = NA)
)

alluvialResults <- if (requireNamespace('jmvcore')) R6::R6Class(
inherit = jmvcore::Group,
active = list(
todo = function() private$.items[["todo"]],
plot = function() private$.items[["plot"]]),
plot = function() private$.items[["plot"]],
plot2 = function() private$.items[["plot2"]]),
private = list(),
public=list(
initialize=function(options) {
Expand All @@ -64,7 +107,9 @@ alluvialResults <- if (requireNamespace('jmvcore')) R6::R6Class(
"vars",
"excl",
"marg",
"inter")))
"verb",
"fill",
"bin")))
self$add(jmvcore::Image$new(
options=options,
title="Alluvial Diagrams",
Expand All @@ -77,7 +122,20 @@ alluvialResults <- if (requireNamespace('jmvcore')) R6::R6Class(
"vars",
"excl",
"marg",
"inter")))}))
"verb",
"fill",
"bin")))
self$add(jmvcore::Image$new(
options=options,
title="`Condensation Plot ${condensationvar}`",
name="plot2",
width=600,
height=450,
renderFun=".plot2",
requiresData=TRUE,
clearWith=list(
"condensationvar"),
visible="(condensationvar)"))}))

alluvialBase <- if (requireNamespace('jmvcore')) R6::R6Class(
"alluvialBase",
Expand Down Expand Up @@ -105,35 +163,51 @@ alluvialBase <- if (requireNamespace('jmvcore')) R6::R6Class(
#' @param data The data as a data frame.
#' @param vars a string naming the variables from \code{data} that contains
#' the values used for the Alluvial Diagram.
#' @param condensationvar The primary variable to be used for condensation.
#' @param excl .
#' @param marg .
#' @param verb .
#' @param fill A list for the argument fill for selecting the variable to be
#' represented by color. Default is 'first_variable'.
#' @param bin labels for the bins from low to high
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$todo} \tab \tab \tab \tab \tab a html \cr
#' \code{results$plot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$plot2} \tab \tab \tab \tab \tab an image \cr
#' }
#'
#' @export
alluvial <- function(
data,
vars,
condensationvar,
excl = TRUE,
marg = FALSE) {
marg = FALSE,
verb = FALSE,
fill = "first_variable",
bin = "default") {

if ( ! requireNamespace('jmvcore'))
stop('alluvial requires jmvcore to be installed (restart may be required)')

if ( ! missing(vars)) vars <- jmvcore::resolveQuo(jmvcore::enquo(vars))
if ( ! missing(condensationvar)) condensationvar <- jmvcore::resolveQuo(jmvcore::enquo(condensationvar))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
`if`( ! missing(vars), vars, NULL))
`if`( ! missing(vars), vars, NULL),
`if`( ! missing(condensationvar), condensationvar, NULL))


options <- alluvialOptions$new(
vars = vars,
condensationvar = condensationvar,
excl = excl,
marg = marg)
marg = marg,
verb = verb,
fill = fill,
bin = bin)

analysis <- alluvialClass$new(
options = options,
Expand Down
4 changes: 3 additions & 1 deletion R/crosstable.b.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,7 +104,9 @@ crosstableClass <- if (requireNamespace('jmvcore')) R6::R6Class(
# myvars <- unlist(myvars)

mydata %>%
summary_factorlist(dependent = self$options$group,
finalfit::summary_factorlist(
.data = .,
dependent = self$options$group,
explanatory = myvars,
# column = TRUE,
total_col = TRUE,
Expand Down
4 changes: 2 additions & 2 deletions R/multisurvival.b.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -144,7 +144,7 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) R6::R6Class(
formulaR <- jmvcore::toNumeric(formulaR)


myformula <- paste("Surv(", formulaL, ",", formulaR, ")")
myformula <- paste("survival::Surv(", formulaL, ",", formulaR, ")")


# https://finalfit.org/reference/hr_plot.html
Expand Down Expand Up @@ -204,7 +204,7 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) R6::R6Class(

formula2 <- jmvcore::constructFormula(terms = self$options$explanatory)

formula3 <- paste("Surv(", formulaL, ",", formulaR, ") ~ ", formula2)
formula3 <- paste("survival::Surv(", formulaL, ",", formulaR, ") ~ ", formula2)

formula3 <- as.formula(formula3)

Expand Down
5 changes: 2 additions & 3 deletions R/reportcat.b.R
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,9 @@
#' @title Summary of Categorical Variables
#'
#'
#'
#' @return Text
#'
#' @importFrom R6 R6Class
#' @import jmvcore
#' @importFrom magrittr %>%
#'

reportcatClass <- if (requireNamespace('jmvcore')) R6::R6Class(
Expand Down
12 changes: 12 additions & 0 deletions README.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,6 +131,18 @@ https://osf.io/9szud/
🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩




#### Alluvial Diagrams

🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩


<img src="man/figures/jamovi-ClinicoPath-easyalluvial.gif" align="center" width = 75% />




---

### Comparisons
Expand Down
Loading

0 comments on commit 1c226e1

Please sign in to comment.