jinseob2kim / jsmodule
Showing 4 of 12 files from the diff.
Newly tracked file
R/line.R created.
Newly tracked file
R/box.R created.
Newly tracked file
R/bar.R created.
Other files ignored by Codecov

@@ -0,0 +1,364 @@
Loading
1 +
#' @title lineUI: shiny module UI for lineplot
2 +
#' @description Shiny module UI for lineplot
3 +
#' @param id id
4 +
#' @param label label
5 +
#' @return Shiny module UI for lineplot
6 +
#' @details Shiny module UI for lineplot
7 +
#' @examples
8 +
#' library(shiny);library(ggplot2);library(ggpubr);
9 +
#' ui <- fluidPage(
10 +
#'    sidebarLayout(
11 +
#'    sidebarPanel(
12 +
#'      lineUI("line")
13 +
#'    ),
14 +
#'    mainPanel(
15 +
#'      plotOutput("line_plot"),
16 +
#'      ggplotdownUI("line")
17 +
#'    )
18 +
#'  )
19 +
#')
20 +
#'
21 +
#' server <- function(input, output, session) {
22 +
#'
23 +
#'   data <- reactive(mtcars)
24 +
#'   data.label <- reactive(jstable::mk.lev(mtcars))
25 +
#'
26 +
#'   out_line <- lineServer("line", data = data, data_label = data.label,
27 +
#'     data_varStruct = NULL)
28 +
#'
29 +
#'   output$line_plot <- renderPlot({
30 +
#'     print(out_line())
31 +
#'   })
32 +
#'}
33 +
#' @rdname lineUI
34 +
#' @export
35 +
36 +
37 +
lineUI <- function(id, label = "lineplot") {
38 +
  # Create a namespace function using the provided id
39 +
  ns <- NS(id)
40 +
41 +
  tagList(
42 +
    uiOutput(ns("vars_line")),
43 +
    uiOutput(ns("strata_line")),
44 +
    radioButtons(ns("options"), "Option", choices = c("Mean_SE", "Mean_SD", "Median_IQR"), selected = "Mean_SE", inline = T),
45 +
    checkboxInput(ns("linetype"), "Linetype"),
46 +
    checkboxInput(ns("jitter"), "Jitter"),
47 +
    uiOutput(ns("subvar")),
48 +
    uiOutput(ns("subval"))
49 +
50 +
  )
51 +
}
52 +
53 +
54 +
#' @title lineServer: shiny module server for lineplot.
55 +
#' @description Shiny module server for lineplot.
56 +
#' @param id id
57 +
#' @param data Reactive data
58 +
#' @param data_label Reactive data label
59 +
#' @param data_varStruct Reactive List of variable structure, Default: NULL
60 +
#' @param nfactor.limit nlevels limit in factor variable, Default: 10
61 +
#' @return Shiny module server for lineplot.
62 +
#' @details Shiny module server for lineplot.
63 +
#' @examples
64 +
#' library(shiny);library(ggplot2);library(ggpubr);
65 +
#' ui <- fluidPage(
66 +
#'    sidebarLayout(
67 +
#'    sidebarPanel(
68 +
#'      lineUI("line")
69 +
#'    ),
70 +
#'    mainPanel(
71 +
#'      plotOutput("line_plot"),
72 +
#'      ggplotdownUI("line")
73 +
#'    )
74 +
#'  )
75 +
#')
76 +
#'
77 +
#' server <- function(input, output, session) {
78 +
#'
79 +
#'   data <- reactive(mtcars)
80 +
#'   data.label <- reactive(jstable::mk.lev(mtcars))
81 +
#'
82 +
#'   out_line <- lineServer("line", data = data, data_label = data.label,
83 +
#'     data_varStruct = NULL)
84 +
#'
85 +
#'   output$line_plot <- renderPlot({
86 +
#'     print(out_line())
87 +
#'   })
88 +
#'}
89 +
#' @rdname lineServer
90 +
#' @export
91 +
#' @import shiny
92 +
#' @importFrom data.table data.table .SD :=
93 +
#' @importFrom ggpubr ggline
94 +
#' @importFrom ggplot2 ggsave
95 +
#' @importFrom rvg dml
96 +
#' @importFrom officer read_pptx add_slide ph_with ph_location
97 +
98 +
99 +
100 +
lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit = 10) {
101 +
  moduleServer(id,
102 +
               function(input, output, session) {
103 +
                 ## To remove NOTE.
104 +
                 level <- val_label <- variable <- NULL
105 +
106 +
                 if (is.null(data_varStruct)){
107 +
                   data_varStruct = reactive(list(variable = names(data())))
108 +
                 }
109 +
110 +
111 +
                 vlist <- reactive({
112 +
113 +
                   data <- data.table(data(), stringsAsFactors = T)
114 +
115 +
                   factor_vars <- names(data)[data[, lapply(.SD, class) %in% c("factor", "character")]]
116 +
                   #data[, (factor_vars) := lapply(.SD, as.factor), .SDcols= factor_vars]
117 +
                   factor_list <- mklist(data_varStruct(), factor_vars)
118 +
119 +
                   nclass_factor <- unlist(data[, lapply(.SD, function(x){length(levels(x))}), .SDcols = factor_vars])
120 +
121 +
                   group_vars <- factor_vars[nclass_factor >=2 & nclass_factor <= nfactor.limit & nclass_factor < nrow(data)]
122 +
                   group_list <- mklist(data_varStruct(), group_vars)
123 +
124 +
                   except_vars <- factor_vars[nclass_factor > nfactor.limit | nclass_factor == 1 | nclass_factor == nrow(data)]
125 +
126 +
                   select_vars <- setdiff(names(data), factor_vars)
127 +
                   select_list <- mklist(data_varStruct(), select_vars)
128 +
129 +
                   return(list(factor_vars = factor_vars, factor_list = factor_list, nclass_factor = nclass_factor, group_vars = group_vars, group_list = group_list, except_vars = except_vars,
130 +
                               select_vars = select_vars, select_list = select_list))
131 +
                 })
132 +
133 +
                 output$vars_line <- renderUI({
134 +
                   tagList(
135 +
                     selectizeInput(session$ns("x_line"), "X variable",
136 +
                                    choices = vlist()$factor_vars, multiple = F,
137 +
                                    selected = vlist()$select_vars[1]
138 +
                     ),
139 +
                     selectizeInput(session$ns("y_line"), "Y variable",
140 +
                                    choices = vlist()$select_list, multiple = F,
141 +
                                    selected = ifelse(length(vlist()$select_vars) > 1, vlist()$select_vars[2], vlist()$select_vars[1])
142 +
                     )
143 +
                   )
144 +
145 +
                 })
146 +
147 +
                 output$strata_line <- renderUI({
148 +
                   strata_vars <- setdiff(vlist()$factor_vars, vlist()$except_vars)
149 +
                   strata_vars <- setdiff(strata_vars, input$x_line)
150 +
                   strata_list <- mklist(data_varStruct(), strata_vars)
151 +
                   strata_select <- c("None", strata_list)
152 +
                   selectizeInput(session$ns("strata"), "Strata",
153 +
                                  choices = strata_select, multiple = F,
154 +
                                  selected = unlist(strata_select)[1]
155 +
                   )
156 +
157 +
                 })
158 +
159 +
160 +
                 observeEvent(input$subcheck, {
161 +
                   output$subvar <- renderUI({
162 +
                     req(input$subcheck == T)
163 +
                     req(!is.null(input$x_line))
164 +
165 +
                     var_subgroup <- setdiff(names(data()), c(vlist()$except_vars, input$x_line, input$y_line, input$strata))
166 +
167 +
                     var_subgroup_list <- mklist(data_varStruct(), var_subgroup)
168 +
                     validate(
169 +
                       need(length(var_subgroup) > 0 , "No variables for sub-group analysis")
170 +
                     )
171 +
172 +
                     tagList(
173 +
                       selectInput(session$ns("subvar_km"), "Sub-group variables",
174 +
                                   choices = var_subgroup_list, multiple = T,
175 +
                                   selected = var_subgroup[1])
176 +
                     )
177 +
178 +
179 +
                   })
180 +
181 +
                 })
182 +
183 +
184 +
                 output$subval <- renderUI({
185 +
                   req(input$subcheck == T)
186 +
                   req(length(input$subvar_km) > 0)
187 +
188 +
                   outUI <- tagList()
189 +
190 +
                   for (v in seq_along(input$subvar_km)){
191 +
                     if (input$subvar_km[[v]] %in% vlist()$factor_vars){
192 +
                       outUI[[v]] <- selectInput(session$ns(paste0("subval_km", v)), paste0("Sub-group value: ", input$subvar_km[[v]]),
193 +
                                                 choices = data_label()[variable == input$subvar_km[[v]], level], multiple = T,
194 +
                                                 selected = data_label()[variable == input$subvar_km[[v]], level][1])
195 +
                     } else{
196 +
                       val <- stats::quantile(data()[[input$subvar_km[[v]]]], na.rm = T)
197 +
                       outUI[[v]] <- sliderInput(session$ns(paste0("subval_km", v)), paste0("Sub-group range: ", input$subvar_km[[v]]),
198 +
                                                 min = val[1], max = val[5],
199 +
                                                 value = c(val[2], val[4]))
200 +
                     }
201 +
202 +
                   }
203 +
                   outUI
204 +
205 +
                 })
206 +
207 +
                 lineInput <- reactive({
208 +
                   req(c(input$x_line, input$y_line, input$strata))
209 +
                   data <- data.table(data())
210 +
                   label <- data_label()
211 +
                   add <- switch(input$options,
212 +
                                 "Mean_SE" = "mean_se",
213 +
                                 "Mean_SD" = "mean_sd",
214 +
                                 "Median_IQR" = "median_iqr"
215 +
                   )
216 +
                   if(input$jitter){
217 +
                     add <- switch(input$options,
218 +
                                   "Mean_SE" = c("jitter", "mean_se"),
219 +
                                   "Mean_SD" = c("jitter","mean_sd"),
220 +
                                   "Median_IQR" = c("jitter", "median_iqr")
221 +
                     )
222 +
                   }
223 +
224 +
225 +
                   color <- ifelse(input$strata == "None", "black", input$strata)
226 +
                   fill <- ifelse(input$strata=="None", input$x_line , input$strata)
227 +
                   if (input$strata != "None"){
228 +
                     data <- data[!is.na(get(input$strata))]
229 +
                   }
230 +
                   add.params <- list()
231 +
                   cor.coeff.args <- list(p.accuracy = 0.001)
232 +
233 +
234 +
235 +
                   linetype = 19
236 +
                   if (input$linetype){
237 +
                     if(input$strata == "None"){
238 +
                       linetype = 20
239 +
                     } else {
240 +
                       linetype <- input$strata
241 +
                     }
242 +
243 +
                   }
244 +
245 +
246 +
                   ggpubr::ggline(data, input$x_line, input$y_line, color = color, add = add, add.params = add.params, conf.int = input$lineci,
247 +
                                  xlab = label[variable == input$x_line, var_label][1],
248 +
                                  ylab = label[variable == input$y_line, var_label][1], na.rm = T,
249 +
                                  linetype = linetype
250 +
                   )
251 +
                 })
252 +
253 +
                 output$downloadControls <- renderUI({
254 +
                   tagList(
255 +
                     column(4,
256 +
                            selectizeInput(session$ns("file_ext"), "File extension (dpi = 300)",
257 +
                                           choices = c("jpg","pdf", "tiff", "svg", "pptx"), multiple = F,
258 +
                                           selected = "pptx"
259 +
                            )
260 +
                     ),
261 +
                     column(4,
262 +
                            sliderInput(session$ns("fig_width"), "Width (in):",
263 +
                                        min = 5, max = 15, value = 8
264 +
                            )
265 +
                     ),
266 +
                     column(4,
267 +
                            sliderInput(session$ns("fig_height"), "Height (in):",
268 +
                                        min = 5, max = 15, value = 6
269 +
                            )
270 +
                     )
271 +
                   )
272 +
                 })
273 +
274 +
                 output$downloadButton <- downloadHandler(
275 +
                   filename =  function() {
276 +
                     paste(input$x_line, "_", input$y_line,"_lineplot.",input$file_ext ,sep="")
277 +
278 +
                   },
279 +
                   # content is a function with argument file. content writes the plot to the device
280 +
                   content = function(file) {
281 +
                     withProgress(message = 'Download in progress',
282 +
                                  detail = 'This may take a while...', value = 0, {
283 +
                                    for (i in 1:15) {
284 +
                                      incProgress(1/15)
285 +
                                      Sys.sleep(0.01)
286 +
                                    }
287 +
288 +
                                    if (input$file_ext == "pptx"){
289 +
                                      my_vec_graph <- rvg::dml(ggobj  = lineInput())
290 +
291 +
                                      doc <- officer::read_pptx()
292 +
                                      doc <- officer::add_slide(doc, layout = "Title and Content", master = "Office Theme")
293 +
                                      doc <- officer::ph_with(doc, my_vec_graph, location = officer::ph_location(width = input$fig_width, height = input$fig_height))
294 +
                                      print(doc, target = file)
295 +
296 +
                                    } else{
297 +
                                      ggplot2::ggsave(file, lineInput(), dpi = 300, units = "in", width = input$fig_width, height =input$fig_height)
298 +
                                    }
299 +
                                  })
300 +
301 +
                   }
302 +
                 )
303 +
304 +
                 return(lineInput)
305 +
306 +
307 +
308 +
309 +
310 +
               }
311 +
  )
312 +
313 +
314 +
315 +
316 +
317 +
318 +
319 +
320 +
321 +
322 +
323 +
324 +
325 +
326 +
327 +
328 +
329 +
330 +
}
331 +
#####
332 +
333 +
334 +
335 +
336 +
# ui <- fluidPage(
337 +
#   sidebarLayout(
338 +
#     sidebarPanel(
339 +
#       lineUI("line")
340 +
#     ),
341 +
#     mainPanel(
342 +
#       plotOutput("line_plot"),
343 +
#       ggplotdownUI("line")
344 +
#     )
345 +
#   )
346 +
# )
347 +
#
348 +
# server <- function(input, output, session) {
349 +
#   mtcars$am <- as.factor(mtcars$am)
350 +
#   mtcars$vs <- as.factor(mtcars$vs)
351 +
#   mtcars$gear <- as.factor(mtcars$gear)
352 +
#   mtcars$carb <- as.factor(mtcars$carb)
353 +
#   mtcars$cyl <- as.factor(mtcars$cyl)
354 +
#   data <- reactive(mtcars)
355 +
#   data.label <- reactive(jstable::mk.lev(mtcars))
356 +
#   out_line <- lineServer("line", data = data, data_label = data.label,
357 +
#                              data_varStruct = NULL)
358 +
#
359 +
#   output$line_plot <- renderPlot({
360 +
#     print(out_line())
361 +
#   })
362 +
# }
363 +
#
364 +
# shinyApp(ui, server)

@@ -0,0 +1,382 @@
Loading
1 +
#' @title boxUI: shiny module UI for boxplot
2 +
#' @description Shiny module UI for boxplot
3 +
#' @param id id
4 +
#' @param label label
5 +
#' @return Shiny module UI for boxplot
6 +
#' @details Shiny module UI for boxplot
7 +
#' @examples
8 +
#' library(shiny);library(ggplot2);library(ggpubr);
9 +
#' ui <- fluidPage(
10 +
#'    sidebarLayout(
11 +
#'    sidebarPanel(
12 +
#'      boxUI("box")
13 +
#'    ),
14 +
#'    mainPanel(
15 +
#'      plotOutput("box_plot"),
16 +
#'      ggplotdownUI("box")
17 +
#'    )
18 +
#'  )
19 +
#')
20 +
#'
21 +
#' server <- function(input, output, session) {
22 +
#'
23 +
#'   data <- reactive(mtcars)
24 +
#'   data.label <- reactive(jstable::mk.lev(mtcars))
25 +
#'
26 +
#'   out_box <- boxServer("box", data = data, data_label = data.label,
27 +
#'     data_varStruct = NULL)
28 +
#'
29 +
#'   output$box_plot <- renderPlot({
30 +
#'     print(out_box())
31 +
#'   })
32 +
#'}
33 +
#' @rdname boxUI
34 +
#' @export
35 +
36 +
37 +
boxUI <- function(id, label = "boxplot") {
38 +
  # Create a namespace function using the provided id
39 +
  ns <- NS(id)
40 +
41 +
  tagList(
42 +
    uiOutput(ns("vars_box")),
43 +
    uiOutput(ns("strata_box")),
44 +
    checkboxInput(ns("errorbar"), "Errorbar"),
45 +
    checkboxInput(ns("jitter"), "Points"),
46 +
    checkboxInput(ns("fillcolor"), "Fill"),
47 +
    uiOutput(ns("subvar")),
48 +
    uiOutput(ns("subval"))
49 +
50 +
  )
51 +
}
52 +
53 +
54 +
#' @title boxServer: shiny module server for boxplot.
55 +
#' @description Shiny module server for boxplot.
56 +
#' @param id id
57 +
#' @param data Reactive data
58 +
#' @param data_label Reactive data label
59 +
#' @param data_varStruct Reactive List of variable structure, Default: NULL
60 +
#' @param nfactor.limit nlevels limit in factor variable, Default: 10
61 +
#' @return Shiny module server for boxplot.
62 +
#' @details Shiny module server for boxplot.
63 +
#' @examples
64 +
#' library(shiny);library(ggplot2);library(ggpubr);
65 +
#' ui <- fluidPage(
66 +
#'    sidebarLayout(
67 +
#'    sidebarPanel(
68 +
#'      boxUI("box")
69 +
#'    ),
70 +
#'    mainPanel(
71 +
#'      plotOutput("box_plot"),
72 +
#'      ggplotdownUI("box")
73 +
#'    )
74 +
#'  )
75 +
#')
76 +
#'
77 +
#' server <- function(input, output, session) {
78 +
#'
79 +
#'   data <- reactive(mtcars)
80 +
#'   data.label <- reactive(jstable::mk.lev(mtcars))
81 +
#'
82 +
#'   out_box <- boxServer("box", data = data, data_label = data.label,
83 +
#'     data_varStruct = NULL)
84 +
#'
85 +
#'   output$box_plot <- renderPlot({
86 +
#'     print(out_box())
87 +
#'   })
88 +
#'}
89 +
#' @rdname boxServer
90 +
#' @export
91 +
#' @import shiny
92 +
#' @importFrom data.table data.table .SD :=
93 +
#' @importFrom ggpubr ggboxplot
94 +
#' @importFrom ggplot2 ggsave
95 +
#' @importFrom rvg dml
96 +
#' @importFrom officer read_pptx add_slide ph_with ph_location
97 +
98 +
99 +
100 +
boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit = 10) {
101 +
  moduleServer(id,
102 +
               function(input, output, session) {
103 +
                 ## To remove NOTE.
104 +
                 level <- val_label <- variable <- NULL
105 +
106 +
                 if (is.null(data_varStruct)){
107 +
                   data_varStruct = reactive(list(variable = names(data())))
108 +
                 }
109 +
110 +
111 +
                 vlist <- reactive({
112 +
113 +
                   data <- data.table(data(), stringsAsFactors = T)
114 +
115 +
                   factor_vars <- names(data)[data[, lapply(.SD, class) %in% c("factor", "character")]]
116 +
                   #data[, (factor_vars) := lapply(.SD, as.factor), .SDcols= factor_vars]
117 +
                   factor_list <- mklist(data_varStruct(), factor_vars)
118 +
119 +
                   nclass_factor <- unlist(data[, lapply(.SD, function(x){length(levels(x))}), .SDcols = factor_vars])
120 +
121 +
                   group_vars <- factor_vars[nclass_factor >=2 & nclass_factor <= nfactor.limit & nclass_factor < nrow(data)]
122 +
                   group_list <- mklist(data_varStruct(), group_vars)
123 +
124 +
                   except_vars <- factor_vars[nclass_factor > nfactor.limit | nclass_factor == 1 | nclass_factor == nrow(data)]
125 +
126 +
                   select_vars <- setdiff(names(data), factor_vars)
127 +
                   select_list <- mklist(data_varStruct(), select_vars)
128 +
129 +
                   return(list(factor_vars = factor_vars, factor_list = factor_list, nclass_factor = nclass_factor, group_vars = group_vars, group_list = group_list, except_vars = except_vars,
130 +
                               select_vars = select_vars, select_list = select_list))
131 +
                 })
132 +
133 +
                 output$vars_box <- renderUI({
134 +
                   tagList(
135 +
                     selectizeInput(session$ns("x_box"), "X variable",
136 +
                                    choices = vlist()$factor_vars, multiple = F,
137 +
                                    selected = vlist()$select_vars[1]
138 +
                     ),
139 +
                     selectizeInput(session$ns("y_box"), "Y variable",
140 +
                                    choices = vlist()$select_list, multiple = F,
141 +
                                    selected = ifelse(length(vlist()$select_vars) > 1, vlist()$select_vars[2], vlist()$select_vars[1])
142 +
                     )
143 +
                   )
144 +
145 +
                 })
146 +
147 +
                 output$strata_box <- renderUI({
148 +
                   strata_vars <- setdiff(vlist()$factor_vars, vlist()$except_vars)
149 +
                   strata_vars <- setdiff(strata_vars, input$x_box)
150 +
                   strata_list <- mklist(data_varStruct(), strata_vars)
151 +
                   strata_select <- c("None", strata_list)
152 +
                   selectizeInput(session$ns("strata"), "Strata",
153 +
                                  choices = strata_select, multiple = F,
154 +
                                  selected = unlist(strata_select)[1]
155 +
                   )
156 +
157 +
                 })
158 +
159 +
160 +
                 observeEvent(input$subcheck, {
161 +
                   output$subvar <- renderUI({
162 +
                     req(input$subcheck == T)
163 +
                     req(!is.null(input$x_box))
164 +
165 +
                     var_subgroup <- setdiff(names(data()), c(vlist()$except_vars, input$x_box, input$y_box, input$strata))
166 +
167 +
                     var_subgroup_list <- mklist(data_varStruct(), var_subgroup)
168 +
                     validate(
169 +
                       need(length(var_subgroup) > 0 , "No variables for sub-group analysis")
170 +
                     )
171 +
172 +
                     tagList(
173 +
                       selectInput(session$ns("subvar_km"), "Sub-group variables",
174 +
                                   choices = var_subgroup_list, multiple = T,
175 +
                                   selected = var_subgroup[1])
176 +
                     )
177 +
178 +
179 +
                   })
180 +
181 +
                 })
182 +
183 +
184 +
                 output$subval <- renderUI({
185 +
                   req(input$subcheck == T)
186 +
                   req(length(input$subvar_km) > 0)
187 +
188 +
                   outUI <- tagList()
189 +
190 +
                   for (v in seq_along(input$subvar_km)){
191 +
                     if (input$subvar_km[[v]] %in% vlist()$factor_vars){
192 +
                       outUI[[v]] <- selectInput(session$ns(paste0("subval_km", v)), paste0("Sub-group value: ", input$subvar_km[[v]]),
193 +
                                                 choices = data_label()[variable == input$subvar_km[[v]], level], multiple = T,
194 +
                                                 selected = data_label()[variable == input$subvar_km[[v]], level][1])
195 +
                     } else{
196 +
                       val <- stats::quantile(data()[[input$subvar_km[[v]]]], na.rm = T)
197 +
                       outUI[[v]] <- sliderInput(session$ns(paste0("subval_km", v)), paste0("Sub-group range: ", input$subvar_km[[v]]),
198 +
                                                 min = val[1], max = val[5],
199 +
                                                 value = c(val[2], val[4]))
200 +
                     }
201 +
202 +
                   }
203 +
                   outUI
204 +
205 +
                 })
206 +
207 +
                 boxInput <- reactive({
208 +
                   req(c(input$x_box, input$y_box, input$strata))
209 +
                   data <- data.table(data())
210 +
                   label <- data_label()
211 +
                   color <- ifelse(input$strata == "None", input$x_box, input$strata)
212 +
                   fill <- ifelse(input$strata=="None", input$x_box , input$strata)
213 +
                   if (input$strata != "None"){
214 +
                     data <- data[!is.na(get(input$strata))]
215 +
                   }
216 +
                   add.params <- list()
217 +
                   cor.coeff.args <- list(p.accuracy = 0.001)
218 +
219 +
                   add ="none"
220 +
                   if (input$jitter){
221 +
                     add <- "jitter"
222 +
                   }
223 +
224 +
                   fillcolor ="white"
225 +
                   if (input$fillcolor){
226 +
                     fillcolor <-"gray"
227 +
                   }
228 +
229 +
                   ggpubr::ggboxplot(data, input$x_box, input$y_box, color = color, add = add, add.params = add.params, conf.int = input$lineci,
230 +
                                     xlab = label[variable == input$x_box, var_label][1],
231 +
                                     ylab = label[variable == input$y_box, var_label][1], na.rm = T, fill=fillcolor, error.plot = "errorbar",
232 +
                                     bxp.errorbar = input$errorbar
233 +
                   )
234 +
                 })
235 +
236 +
                 output$downloadControls <- renderUI({
237 +
                   tagList(
238 +
                     column(4,
239 +
                            selectizeInput(session$ns("file_ext"), "File extension (dpi = 300)",
240 +
                                           choices = c("jpg","pdf", "tiff", "svg", "pptx"), multiple = F,
241 +
                                           selected = "pptx"
242 +
                            )
243 +
                     ),
244 +
                     column(4,
245 +
                            sliderInput(session$ns("fig_width"), "Width (in):",
246 +
                                        min = 5, max = 15, value = 8
247 +
                            )
248 +
                     ),
249 +
                     column(4,
250 +
                            sliderInput(session$ns("fig_height"), "Height (in):",
251 +
                                        min = 5, max = 15, value = 6
252 +
                            )
253 +
                     )
254 +
                   )
255 +
                 })
256 +
257 +
                 output$downloadButton <- downloadHandler(
258 +
                   filename =  function() {
259 +
                     paste(input$x_box, "_", input$y_box,"_boxplot.",input$file_ext ,sep="")
260 +
261 +
                   },
262 +
                   # content is a function with argument file. content writes the plot to the device
263 +
                   content = function(file) {
264 +
                     withProgress(message = 'Download in progress',
265 +
                                  detail = 'This may take a while...', value = 0, {
266 +
                                    for (i in 1:15) {
267 +
                                      incProgress(1/15)
268 +
                                      Sys.sleep(0.01)
269 +
                                    }
270 +
271 +
                                    if (input$file_ext == "pptx"){
272 +
                                      my_vec_graph <- rvg::dml(ggobj  = boxInput())
273 +
274 +
                                      doc <- officer::read_pptx()
275 +
                                      doc <- officer::add_slide(doc, layout = "Title and Content", master = "Office Theme")
276 +
                                      doc <- officer::ph_with(doc, my_vec_graph, location = officer::ph_location(width = input$fig_width, height = input$fig_height))
277 +
                                      print(doc, target = file)
278 +
279 +
                                    } else{
280 +
                                      ggplot2::ggsave(file, boxInput(), dpi = 300, units = "in", width = input$fig_width, height =input$fig_height)
281 +
                                    }
282 +
                                  })
283 +
284 +
                   }
285 +
                 )
286 +
287 +
                 return(boxInput)
288 +
289 +
290 +
291 +
292 +
293 +
               }
294 +
  )
295 +
296 +
297 +
298 +
299 +
300 +
301 +
302 +
303 +
304 +
305 +
306 +
307 +
308 +
309 +
310 +
311 +
312 +
313 +
}
314 +
#####
315 +
316 +
317 +
#
318 +
# ui <- navbarPage("basic statistics",
319 +
#                  navbarMenu("Plot", icon = icon("bar-chart-o"),
320 +
#                             tabPanel("Boxplot",
321 +
#                                      sidebarLayout(
322 +
#                                        sidebarPanel(
323 +
#                                          boxUI("box")
324 +
#                                        ),
325 +
#                                        mainPanel(
326 +
#                                          withLoader(plotOutput("box_plot"), type="html", loader="loader6"),
327 +
#                                          ggplotdownUI("box")
328 +
#                                        )
329 +
#                                      )
330 +
#                             )
331 +
#                  )
332 +
# )
333 +
#
334 +
# server <- function(input, output, session){
335 +
#
336 +
#       data <- reactive(mtcars)
337 +
#       data.label <- reactive(jstable::mk.lev(mtcars))
338 +
#       out_box <- boxServer("box", data = data, data_label = data.label, data_varStruct = NULL, nfactor.limit = 20)
339 +
#
340 +
#       output$box_plot <- renderPlot({
341 +
#         print(out_box())
342 +
#
343 +
#
344 +
 # output$box_plot <- renderPlot({
345 +
#   #  print(out_box())
346 +
#   })
347 +
# }
348 +
#
349 +
# shinyApp(ui, server)
350 +
351 +
#
352 +
#
353 +
# ui <- fluidPage(
354 +
#   sidebarLayout(
355 +
#     sidebarPanel(
356 +
#       boxUI("box")
357 +
#     ),
358 +
#     mainPanel(
359 +
#       plotOutput("box_plot"),
360 +
#       ggplotdownUI("box")
361 +
#     )
362 +
#   )
363 +
# )
364 +
#
365 +
# server <- function(input, output, session) {
366 +
#   mtcars$am <- as.factor(mtcars$am)
367 +
#   mtcars$vs <- as.factor(mtcars$vs)
368 +
#   mtcars$gear <- as.factor(mtcars$gear)
369 +
#   mtcars$carb <- as.factor(mtcars$carb)
370 +
#   mtcars$cyl <- as.factor(mtcars$cyl)
371 +
#   data <- reactive(mtcars)
372 +
#   data.label <- reactive(jstable::mk.lev(mtcars))
373 +
#   out_box <- boxServer("box", data = data, data_label = data.label,
374 +
#                            data_varStruct = NULL)
375 +
#
376 +
#   output$box_plot <- renderPlot({
377 +
#     print(out_box())
378 +
#   })
379 +
# }
380 +
#
381 +
# shinyApp(ui, server)
382 +

@@ -142,6 +142,39 @@
Loading
142 142
                                         )
143 143
                                       )
144 144
                              ),
145 +
                              tabPanel("Boxplot",
146 +
                                       sidebarLayout(
147 +
                                         sidebarPanel(
148 +
                                           boxUI("box")
149 +
                                         ),
150 +
                                         mainPanel(
151 +
                                           withLoader(plotOutput("box_plot"), type="html", loader="loader6"),
152 +
                                           ggplotdownUI("box")
153 +
                                         )
154 +
                                       )
155 +
                              ),
156 +
                              tabPanel("Barplot",
157 +
                                       sidebarLayout(
158 +
                                         sidebarPanel(
159 +
                                           barUI("bar")
160 +
                                         ),
161 +
                                         mainPanel(
162 +
                                           withLoader(plotOutput("bar_plot"), type="html", loader="loader6"),
163 +
                                           ggplotdownUI("bar")
164 +
                                         )
165 +
                                       )
166 +
                              ),
167 +
                              tabPanel("Lineplot",
168 +
                                       sidebarLayout(
169 +
                                         sidebarPanel(
170 +
                                           lineUI("line")
171 +
                                         ),
172 +
                                         mainPanel(
173 +
                                           withLoader(plotOutput("line_plot"), type="html", loader="loader6"),
174 +
                                           ggplotdownUI("line")
175 +
                                         )
176 +
                                       )
177 +
                              ),
145 178
                              tabPanel("Kaplan-meier plot",
146 179
                                       sidebarLayout(
147 180
                                         sidebarPanel(
@@ -423,11 +456,11 @@
Loading
423 456
      tb <- out_tb1()$table
424 457
      cap <- out_tb1()$caption
425 458
      out.tb1 <- datatable(tb, rownames = T, extensions = "Buttons", caption = cap,
426 -
                          options = c(jstable::opt.tb1("tb1"),
427 -
                                      list(columnDefs = list(list(visible=FALSE, targets= which(colnames(tb) %in% c("test","sig"))))
428 -
                                      ),
429 -
                                      list(scrollX = TRUE)
430 -
                          )
459 +
                           options = c(jstable::opt.tb1("tb1"),
460 +
                                       list(columnDefs = list(list(visible=FALSE, targets= which(colnames(tb) %in% c("test","sig"))))
461 +
                                       ),
462 +
                                       list(scrollX = TRUE)
463 +
                           )
431 464
      )
432 465
      if ("sig" %in% colnames(tb)){
433 466
        out.tb1 = out.tb1 %>% formatStyle("sig", target = 'row' ,backgroundColor = styleEqual("**", 'yellow'))
@@ -490,6 +523,24 @@
Loading
490 523
      print(out_scatter())
491 524
    })
492 525
526 +
    out_box <- boxServer("box", data = data, data_label = data.label, data_varStruct = NULL, nfactor.limit = nfactor.limit)
527 +
528 +
    output$box_plot <- renderPlot({
529 +
      print(out_box())
530 +
    })
531 +
532 +
    out_bar <- barServer("bar", data = data, data_label = data.label, data_varStruct = NULL, nfactor.limit = nfactor.limit)
533 +
534 +
    output$bar_plot <- renderPlot({
535 +
      print(out_bar())
536 +
    })
537 +
538 +
    out_line <- lineServer("line", data = data, data_label = data.label, data_varStruct = NULL, nfactor.limit = nfactor.limit)
539 +
540 +
    output$line_plot <- renderPlot({
541 +
      print(out_line())
542 +
    })
543 +
493 544
    out_kaplan <- callModule(kaplanModule, "kaplan", data = data, data_label = data.label, data_varStruct = NULL, nfactor.limit = nfactor.limit)
494 545
495 546
    output$kaplan_plot <- renderPlot({
@@ -684,6 +735,39 @@
Loading
684 735
                                         )
685 736
                                       )
686 737
                              ),
738 +
                              tabPanel("Boxplot",
739 +
                                       sidebarLayout(
740 +
                                         sidebarPanel(
741 +
                                           boxUI("box")
742 +
                                         ),
743 +
                                         mainPanel(
744 +
                                           withLoader(plotOutput("box_plot"), type="html", loader="loader6"),
745 +
                                           ggplotdownUI("box")
746 +
                                         )
747 +
                                       )
748 +
                              ),
749 +
                              tabPanel("Barplot",
750 +
                                       sidebarLayout(
751 +
                                         sidebarPanel(
752 +
                                           barUI("bar")
753 +
                                         ),
754 +
                                         mainPanel(
755 +
                                           withLoader(plotOutput("bar_plot"), type="html", loader="loader6"),
756 +
                                           ggplotdownUI("bar")
757 +
                                         )
758 +
                                       )
759 +
                              ),
760 +
                              tabPanel("Lineplot",
761 +
                                       sidebarLayout(
762 +
                                         sidebarPanel(
763 +
                                           lineUI("line")
764 +
                                         ),
765 +
                                         mainPanel(
766 +
                                           withLoader(plotOutput("line_plot"), type="html", loader="loader6"),
767 +
                                           ggplotdownUI("line")
768 +
                                         )
769 +
                                       )
770 +
                              ),
687 771
                              tabPanel("Kaplan-meier plot",
688 772
                                       sidebarLayout(
689 773
                                         sidebarPanel(
@@ -844,6 +928,25 @@
Loading
844 928
      print(out_scatter())
845 929
    })
846 930
931 +
    out_box <- boxServer("box", data = data, data_label = data.label, data_varStruct = NULL, nfactor.limit = nfactor.limit)
932 +
933 +
    output$box_plot <- renderPlot({
934 +
      print(out_box())
935 +
    })
936 +
937 +
    out_bar <- barServer("bar", data = data, data_label = data.label, data_varStruct = NULL, nfactor.limit = nfactor.limit)
938 +
939 +
    output$bar_plot <- renderPlot({
940 +
      print(out_bar())
941 +
    })
942 +
943 +
    out_line <- lineServer("line", data = data, data_label = data.label, data_varStruct = NULL, nfactor.limit = nfactor.limit)
944 +
945 +
    output$line_plot <- renderPlot({
946 +
      print(out_line())
947 +
    })
948 +
949 +
847 950
    out_kaplan <- callModule(kaplanModule, "kaplan", data = data, data_label = data.label, data_varStruct = NULL, nfactor.limit = nfactor.limit)
848 951
849 952
    output$kaplan_plot <- renderPlot({

@@ -0,0 +1,356 @@
Loading
1 +
#' @title barUI: shiny module UI for barplot
2 +
#' @description Shiny module UI for barplot
3 +
#' @param id id
4 +
#' @param label label
5 +
#' @return Shiny module UI for barplot
6 +
#' @details Shiny module UI for barplot
7 +
#' @examples
8 +
#' library(shiny);library(ggplot2);library(ggpubr);
9 +
#' ui <- fluidPage(
10 +
#'    sidebarLayout(
11 +
#'    sidebarPanel(
12 +
#'      barUI("bar")
13 +
#'    ),
14 +
#'    mainPanel(
15 +
#'      plotOutput("bar_plot"),
16 +
#'      ggplotdownUI("bar")
17 +
#'    )
18 +
#'  )
19 +
#')
20 +
#'
21 +
#' server <- function(input, output, session) {
22 +
#'
23 +
#'   data <- reactive(mtcars)
24 +
#'   data.label <- reactive(jstable::mk.lev(mtcars))
25 +
#'
26 +
#'   out_bar <- barServer("bar", data = data, data_label = data.label,
27 +
#'     data_varStruct = NULL)
28 +
#'
29 +
#'   output$bar_plot <- renderPlot({
30 +
#'     print(out_bar())
31 +
#'   })
32 +
#'}
33 +
#' @rdname barUI
34 +
#' @export
35 +
36 +
37 +
38 +
barUI <- function(id, label = "barplot") {
39 +
  # Create a namespace function using the provided id
40 +
  ns <- NS(id)
41 +
42 +
  tagList(
43 +
    uiOutput(ns("vars_bar")),
44 +
    uiOutput(ns("strata_bar")),
45 +
    checkboxInput(ns("fill"), "Fill"),
46 +
    checkboxInput(ns("mean"), "Mean_SE"),
47 +
    checkboxInput(ns("jitter"), "Jitter"),
48 +
    uiOutput(ns("subvar")),
49 +
    uiOutput(ns("subval"))
50 +
51 +
  )
52 +
}
53 +
54 +
55 +
#' @title barServer: shiny module server for barplot.
56 +
#' @description Shiny module server for barplot.
57 +
#' @param id id
58 +
#' @param data Reactive data
59 +
#' @param data_label Reactive data label
60 +
#' @param data_varStruct Reactive List of variable structure, Default: NULL
61 +
#' @param nfactor.limit nlevels limit in factor variable, Default: 10
62 +
#' @return Shiny module server for barplot.
63 +
#' @details Shiny module server for barplot.
64 +
#' @examples
65 +
#' library(shiny);library(ggplot2);library(ggpubr);
66 +
#' ui <- fluidPage(
67 +
#'    sidebarLayout(
68 +
#'    sidebarPanel(
69 +
#'      barUI("bar")
70 +
#'    ),
71 +
#'    mainPanel(
72 +
#'      plotOutput("bar_plot"),
73 +
#'      ggplotdownUI("bar")
74 +
#'    )
75 +
#'  )
76 +
#')
77 +
#'
78 +
#' server <- function(input, output, session) {
79 +
#'
80 +
#'   data <- reactive(mtcars)
81 +
#'   data.label <- reactive(jstable::mk.lev(mtcars))
82 +
#'
83 +
#'   out_bar <- barServer("bar", data = data, data_label = data.label,
84 +
#'     data_varStruct = NULL)
85 +
#'
86 +
#'   output$bar_plot <- renderPlot({
87 +
#'     print(out_bar())
88 +
#'   })
89 +
#'}
90 +
#' @rdname barServer
91 +
#' @export
92 +
#' @import shiny
93 +
#' @importFrom data.table data.table .SD :=
94 +
#' @importFrom ggpubr ggbarplot
95 +
#' @importFrom ggplot2 ggsave
96 +
#' @importFrom rvg dml
97 +
#' @importFrom officer read_pptx add_slide ph_with ph_location
98 +
99 +
100 +
101 +
barServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit = 10) {
102 +
  moduleServer(id,
103 +
               function(input, output, session) {
104 +
                 ## To remove NOTE.
105 +
                 level <- val_label <- variable <- NULL
106 +
107 +
                 if (is.null(data_varStruct)){
108 +
                   data_varStruct = reactive(list(variable = names(data())))
109 +
                 }
110 +
111 +
112 +
                 vlist <- reactive({
113 +
114 +
                   data <- data.table(data(), stringsAsFactors = T)
115 +
116 +
                   factor_vars <- names(data)[data[, lapply(.SD, class) %in% c("factor", "character")]]
117 +
                   #data[, (factor_vars) := lapply(.SD, as.factor), .SDcols= factor_vars]
118 +
                   factor_list <- mklist(data_varStruct(), factor_vars)
119 +
120 +
                   nclass_factor <- unlist(data[, lapply(.SD, function(x){length(levels(x))}), .SDcols = factor_vars])
121 +
122 +
                   group_vars <- factor_vars[nclass_factor >=2 & nclass_factor <= nfactor.limit & nclass_factor < nrow(data)]
123 +
                   group_list <- mklist(data_varStruct(), group_vars)
124 +
125 +
                   except_vars <- factor_vars[nclass_factor > nfactor.limit | nclass_factor == 1 | nclass_factor == nrow(data)]
126 +
127 +
                   select_vars <- setdiff(names(data), factor_vars)
128 +
                   select_list <- mklist(data_varStruct(), select_vars)
129 +
130 +
                   return(list(factor_vars = factor_vars, factor_list = factor_list, nclass_factor = nclass_factor, group_vars = group_vars, group_list = group_list, except_vars = except_vars,
131 +
                               select_vars = select_vars, select_list = select_list))
132 +
                 })
133 +
134 +
                 output$vars_bar <- renderUI({
135 +
                   tagList(
136 +
                     selectizeInput(session$ns("x_bar"), "X variable",
137 +
                                    choices = vlist()$factor_vars, multiple = F,
138 +
                                    selected = vlist()$select_vars[1]
139 +
                     ),
140 +
                     selectizeInput(session$ns("y_bar"), "Y variable",
141 +
                                    choices = vlist()$select_list, multiple = F,
142 +
                                    selected = ifelse(length(vlist()$select_vars) > 1, vlist()$select_vars[2], vlist()$select_vars[1])
143 +
                     )
144 +
                   )
145 +
146 +
                 })
147 +
148 +
                 output$strata_bar <- renderUI({
149 +
                   strata_vars <- setdiff(vlist()$factor_vars, vlist()$except_vars)
150 +
                   strata_vars <- setdiff(strata_vars, input$x_bar)
151 +
                   strata_list <- mklist(data_varStruct(), strata_vars)
152 +
                   strata_select <- c("None", strata_list)
153 +
                   selectizeInput(session$ns("strata"), "Strata",
154 +
                                  choices = strata_select, multiple = F,
155 +
                                  selected = unlist(strata_select)[1]
156 +
                   )
157 +
158 +
                 })
159 +
160 +
161 +
                 observeEvent(input$subcheck, {
162 +
                   output$subvar <- renderUI({
163 +
                     req(input$subcheck == T)
164 +
                     req(!is.null(input$x_bar))
165 +
166 +
                     var_subgroup <- setdiff(names(data()), c(vlist()$except_vars, input$x_bar, input$y_bar, input$strata))
167 +
168 +
                     var_subgroup_list <- mklist(data_varStruct(), var_subgroup)
169 +
                     validate(
170 +
                       need(length(var_subgroup) > 0 , "No variables for sub-group analysis")
171 +
                     )
172 +
173 +
                     tagList(
174 +
                       selectInput(session$ns("subvar_km"), "Sub-group variables",
175 +
                                   choices = var_subgroup_list, multiple = T,
176 +
                                   selected = var_subgroup[1])
177 +
                     )
178 +
179 +
180 +
                   })
181 +
182 +
                 })
183 +
184 +
185 +
                 output$subval <- renderUI({
186 +
                   req(input$subcheck == T)
187 +
                   req(length(input$subvar_km) > 0)
188 +
189 +
                   outUI <- tagList()
190 +
191 +
                   for (v in seq_along(input$subvar_km)){
192 +
                     if (input$subvar_km[[v]] %in% vlist()$factor_vars){
193 +
                       outUI[[v]] <- selectInput(session$ns(paste0("subval_km", v)), paste0("Sub-group value: ", input$subvar_km[[v]]),
194 +
                                                 choices = data_label()[variable == input$subvar_km[[v]], level], multiple = T,
195 +
                                                 selected = data_label()[variable == input$subvar_km[[v]], level][1])
196 +
                     } else{
197 +
                       val <- stats::quantile(data()[[input$subvar_km[[v]]]], na.rm = T)
198 +
                       outUI[[v]] <- sliderInput(session$ns(paste0("subval_km", v)), paste0("Sub-group range: ", input$subvar_km[[v]]),
199 +
                                                 min = val[1], max = val[5],
200 +
                                                 value = c(val[2], val[4]))
201 +
                     }
202 +
203 +
                   }
204 +
                   outUI
205 +
206 +
                 })
207 +
208 +
                 barInput <- reactive({
209 +
                   req(c(input$x_bar, input$y_bar, input$strata))
210 +
                   data <- data.table(data())
211 +
                   label <- data_label()
212 +
                   color <- ifelse(input$strata == "None", "black", input$strata)
213 +
                   fill = "white"
214 +
                   if(input$fill){
215 +
                     fill <- ifelse(input$strata == "None", input$x_bar, input$strata)
216 +
                   }
217 +
218 +
                   if (input$strata != "None"){
219 +
                     data <- data[!is.na(get(input$strata))]
220 +
                   }
221 +
                   add.params <- list()
222 +
                   cor.coeff.args <- list(p.accuracy = 0.001)
223 +
224 +
                   add ="mean"
225 +
                   if (input$jitter){
226 +
                     add <- c("mean", "jitter")
227 +
                   }
228 +
                   if (input$mean){
229 +
                     add <- "mean_se"
230 +
                   }
231 +
                   if (input$mean & input$jitter){
232 +
                     add <- c("jitter", "mean_se")
233 +
                   }
234 +
235 +
236 +
237 +
                   ggpubr::ggbarplot(data, input$x_bar, input$y_bar, color = color, add = add, add.params = add.params, conf.int = input$lineci,
238 +
                                     xlab = label[variable == input$x_bar, var_label][1],
239 +
                                     ylab = label[variable == input$y_bar, var_label][1], na.rm = T,
240 +
                                     position = position_dodge(),fill=fill,
241 +
242 +
                   )
243 +
                 })
244 +
245 +
                 output$downloadControls <- renderUI({
246 +
                   tagList(
247 +
                     column(4,
248 +
                            selectizeInput(session$ns("file_ext"), "File extension (dpi = 300)",
249 +
                                           choices = c("jpg","pdf", "tiff", "svg", "pptx"), multiple = F,
250 +
                                           selected = "pptx"
251 +
                            )
252 +
                     ),
253 +
                     column(4,
254 +
                            sliderInput(session$ns("fig_width"), "Width (in):",
255 +
                                        min = 5, max = 15, value = 8
256 +
                            )
257 +
                     ),
258 +
                     column(4,
259 +
                            sliderInput(session$ns("fig_height"), "Height (in):",
260 +
                                        min = 5, max = 15, value = 6
261 +
                            )
262 +
                     )
263 +
                   )
264 +
                 })
265 +
266 +
                 output$downloadButton <- downloadHandler(
267 +
                   filename =  function() {
268 +
                     paste(input$x_bar, "_", input$y_bar,"_barplot.",input$file_ext ,sep="")
269 +
270 +
                   },
271 +
                   # content is a function with argument file. content writes the plot to the device
272 +
                   content = function(file) {
273 +
                     withProgress(message = 'Download in progress',
274 +
                                  detail = 'This may take a while...', value = 0, {
275 +
                                    for (i in 1:15) {
276 +
                                      incProgress(1/15)
277 +
                                      Sys.sleep(0.01)
278 +
                                    }
279 +
280 +
                                    if (input$file_ext == "pptx"){
281 +
                                      my_vec_graph <- rvg::dml(ggobj  = barInput())
282 +
283 +
                                      doc <- officer::read_pptx()
284 +
                                      doc <- officer::add_slide(doc, layout = "Title and Content", master = "Office Theme")
285 +
                                      doc <- officer::ph_with(doc, my_vec_graph, location = officer::ph_location(width = input$fig_width, height = input$fig_height))
286 +
                                      print(doc, target = file)
287 +
288 +
                                    } else{
289 +
                                      ggplot2::ggsave(file, barInput(), dpi = 300, units = "in", width = input$fig_width, height =input$fig_height)
290 +
                                    }
291 +
                                  })
292 +
293 +
                   }
294 +
                 )
295 +
296 +
                 return(barInput)
297 +
298 +
299 +
300 +
301 +
302 +
               }
303 +
  )
304 +
305 +
306 +
307 +
308 +
309 +
310 +
311 +
312 +
313 +
314 +
315 +
316 +
317 +
318 +
319 +
320 +
321 +
322 +
}
323 +
#####
324 +
325 +
326 +
#
327 +
#
328 +
# ui <- fluidPage(
329 +
#   sidebarLayout(
330 +
#     sidebarPanel(
331 +
#       barUI("bar")
332 +
#     ),
333 +
#     mainPanel(
334 +
#       plotOutput("bar_plot"),
335 +
#       ggplotdownUI("bar")
336 +
#     )
337 +
#   )
338 +
# )
339 +
#
340 +
# server <- function(input, output, session) {
341 +
#   mtcars$am <- as.factor(mtcars$am)
342 +
#   mtcars$vs <- as.factor(mtcars$vs)
343 +
#   mtcars$gear <- as.factor(mtcars$gear)
344 +
#   mtcars$carb <- as.factor(mtcars$carb)
345 +
#   mtcars$cyl <- as.factor(mtcars$cyl)
346 +
#   data <- reactive(mtcars)
347 +
#   data.label <- reactive(jstable::mk.lev(mtcars))
348 +
#   out_bar <- barServer("bar", data = data, data_label = data.label,
349 +
#                            data_varStruct = NULL)
350 +
#
351 +
#   output$bar_plot <- renderPlot({
352 +
#     print(out_bar())
353 +
#   })
354 +
# }
355 +
#
356 +
# shinyApp(ui, server)
Files Coverage
R 5.95%
Project Totals (22 files) 5.95%

No yaml found.

Create your codecov.yml to customize your Codecov experience

Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading