Skip to content

Commit

Permalink
Merge pull request #23 from koolerjaebee/master
Browse files Browse the repository at this point in the history 
Fix optionUI feat conflict & test app.R renewal
  • Loading branch information
@jinseob2kim
jinseob2kim authored Mar 22, 2024
2 parents 0a29e9b + 2b6ce84 commit d6926fd
Show file tree
Hide file tree
Showing 4 changed files with 106 additions and 61 deletions.
29 changes: 11 additions & 18 deletions R/bar.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,16 +56,16 @@ barUI <- function(id, label = "barplot") {
}


optionUI <- function(id) {
# Create a namespace function using the provided id
ns <- NS(id)

shinyWidgets::dropdownButton(
uiOutput(ns("option_bar")),
circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
tooltip = shinyWidgets::tooltipOptions(title = "Click to see other options !")
)
}
# optionUI <- function(id) {
# # Create a namespace function using the provided id
# ns <- NS(id)
#
# shinyWidgets::dropdownButton(
# uiOutput(ns("option_bar")),
# circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
# tooltip = shinyWidgets::tooltipOptions(title = "Click to see other options !")
# )
# }


#' @title barServer: shiny module server for barplot.
Expand Down Expand Up @@ -596,14 +596,7 @@ barServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit


# option dropdown menu
output$option_bar <- renderUI({
nclass.factor <- vlist()$nclass_factor[input$x_bar]
if (nclass.factor > 2 & input$strata == "None") {
tabset.selected <- "over_three"
} else {
tabset.selected <- "under_three"
}

output$option_kaplan <- renderUI({
tagList(
h3("P-value position"),
sliderInput(session$ns("pvalfont"), "P-value font size",
Expand Down
31 changes: 12 additions & 19 deletions R/box.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,16 +55,16 @@ boxUI <- function(id, label = "boxplot") {
}


optionUI <- function(id) {
# Create a namespace function using the provided id
ns <- NS(id)

shinyWidgets::dropdownButton(
uiOutput(ns("option_box")),
circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
tooltip = shinyWidgets::tooltipOptions(title = "Click to see other options !")
)
}
# optionUI <- function(id) {
# # Create a namespace function using the provided id
# ns <- NS(id)
#
# shinyWidgets::dropdownButton(
# uiOutput(ns("option_box")),
# circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
# tooltip = shinyWidgets::tooltipOptions(title = "Click to see other options !")
# )
# }


#' @title boxServer: shiny module server for boxplot.
Expand Down Expand Up @@ -389,7 +389,7 @@ boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit

observeEvent(input$isPair, {
msg <- boxInputError()
if (!is.ggplot(msg)) showNotification(msg, type = "warning")
if (msg != "" & msg != "Success") showNotification(msg, type = "warning")
updateTabsetPanel(session, "side_tabset_ppvalradio", selected = ifelse(input$isPair, "isPairTrue", "isPairFalse"))
})

Expand Down Expand Up @@ -587,14 +587,7 @@ boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit


# option dropdown menu
output$option_box <- renderUI({
nclass.factor <- vlist()$nclass_factor[input$x_box]
if (nclass.factor > 2 & input$strata == "None") {
tabset.selected <- "over_three"
} else {
tabset.selected <- "under_three"
}

output$option_kaplan <- renderUI({
tagList(
h3("P-value position"),
sliderInput(session$ns("pvalfont"), "P-value font size",
Expand Down
47 changes: 24 additions & 23 deletions R/line.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,16 +58,16 @@ lineUI <- function(id, label = "lineplot") {
}


optionUI <- function(id) {
# Create a namespace function using the provided id
ns <- NS(id)

shinyWidgets::dropdownButton(
uiOutput(ns("option_line")),
circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
tooltip = shinyWidgets::tooltipOptions(title = "Click to see other options !")
)
}
# optionUI <- function(id) {
# # Create a namespace function using the provided id
# ns <- NS(id)
#
# shinyWidgets::dropdownButton(
# uiOutput(ns("option_line")),
# circle = TRUE, status = "danger", icon = icon("gear"), width = "300px",
# tooltip = shinyWidgets::tooltipOptions(title = "Click to see other options !")
# )
# }


#' @title lineServer: shiny module server for lineplot.
Expand Down Expand Up @@ -318,9 +318,9 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi


observeEvent(input$pval_reset, {
updateSliderInput(session, "positiondodge", value = 0)
updateNumericInput(session, "size", value = 0.5)
updateNumericInput(session, "pointsize", value = 0.5)
updateSliderInput(session, "positiondodge", value = 0)
updateSliderInput(session, "pvalfont", value = 4)
})

Expand Down Expand Up @@ -400,20 +400,25 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
}

if (is.null(input$pvalfont)) {
pval.font.size <- 4
line.position.dodge <- 0
line.size <- 0.5
line.point.size <- 0.5
pval.font.size <- 4
} else {
pval.font.size <- input$pvalfont
line.position.dodge <- input$positiondodge
line.size <- input$size
line.point.size <- input$pointsize
pval.font.size = input$pvalfont
}
spval.name <- input$s_pvalue


res.plot <- ggpubr::ggline(data, input$x_line, input$y_line,
color = color, add = add, add.params = add.params, conf.int = input$lineci,
xlab = label[variable == input$x_line, var_label][1],
ylab = label[variable == input$y_line, var_label][1], na.rm = T,
position = position_dodge(input$positiondodge),
size = input$size,
point.size = input$pointsize,
position = position_dodge(line.position.dodge),
size = line.size,
point.size = line.point.size,
linetype = linetype
)

Expand All @@ -424,7 +429,7 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
if (input$isStrata & input$strata != "None") {
res.plot <- res.plot +
ggpubr::stat_compare_means(
method = spval.name,
method = input$s_pvalue,
size = pval.font.size,
aes(
label = scales::label_pvalue(add_p = TRUE)(after_stat(p)),
Expand All @@ -433,10 +438,6 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
)
}

if (input$rev_y) {
res.plot <- res.plot + ggplot2::scale_y_reverse()
}

return(res.plot)
})

Expand Down Expand Up @@ -497,7 +498,7 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi


# option dropdown menu
output$option_line <- renderUI({
output$option_kaplan <- renderUI({
tagList(
h3("Line setting"),
fluidRow(
Expand Down
60 changes: 59 additions & 1 deletion tests/testthat/shinytest/basic/app.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,7 @@ ui <- navbarPage(
)
),
navbarMenu("Plot",
icon = icon("bar-chart-o"),
icon = icon("chart-column"),
tabPanel(
"Scatter plot",
sidebarLayout(
Expand All @@ -98,10 +98,50 @@ ui <- navbarPage(
kaplanUI("kaplan")
),
mainPanel(
optionUI("kaplan"),
withLoader(plotOutput("kaplan_plot"), type = "html", loader = "loader6"),
ggplotdownUI("kaplan")
)
)
),
tabPanel(
"Box plot",
sidebarLayout(
sidebarPanel(
boxUI("box")
),
mainPanel(
optionUI("box"),
withLoader(plotOutput("box_plot"), type = "html", loader = "loader6"),
ggplotdownUI("box")
)
)
),
tabPanel(
"Bar plot",
sidebarLayout(
sidebarPanel(
barUI("bar")
),
mainPanel(
optionUI("bar"),
withLoader(plotOutput("bar_plot"), type = "html", loader = "loader6"),
ggplotdownUI("bar")
)
)
),
tabPanel(
"Line plot",
sidebarLayout(
sidebarPanel(
lineUI("line")
),
mainPanel(
optionUI("line"),
withLoader(plotOutput("line_plot"), type = "html", loader = "loader6"),
ggplotdownUI("line")
)
)
)
)
)
Expand Down Expand Up @@ -298,6 +338,24 @@ server <- function(input, output, session) {
output$kaplan_plot <- renderPlot({
print(out_kaplan())
})

out_box <- boxServer("box", data = data, data_label = data.label, data_varStruct = NULL)

output$box_plot <- renderPlot({
print(out_box())
})

out_bar <- barServer("bar", data = data, data_label = data.label, data_varStruct = NULL)

output$bar_plot <- renderPlot({
print(out_bar())
})

out_line <- lineServer("line", data = data, data_label = data.label, data_varStruct = NULL)

output$line_plot <- renderPlot({
print(out_line())
})
}


Expand Down

0 comments on commit d6926fd

Please sign in to comment.