Skip to content

Commit

Permalink
change box plot color setting
Browse files Browse the repository at this point in the history
  • Loading branch information
ddspys committed Nov 11, 2024
1 parent 4036e8b commit 5f53f1c
Show file tree
Hide file tree
Showing 3 changed files with 69 additions and 8 deletions.
2 changes: 1 addition & 1 deletion R/bar.R
Original file line number Diff line number Diff line change
Expand Up @@ -600,7 +600,7 @@ barServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
min = 0, max = 1, value = 0.5
),
sliderInput(session$ns("pvaly"), "y-axis",
min = 0, max = 1, value = 1
min = 0, max = 1, value = 0.7
),
h3("Pair P-value position"),
sliderInput(session$ns("p_pvalfont"), "P-value font size",
Expand Down
3 changes: 2 additions & 1 deletion R/box.R
Original file line number Diff line number Diff line change
Expand Up @@ -473,7 +473,8 @@ boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit

fillcolor <- "white"
if (input$fillcolor) {
fillcolor <- "gray"
fillcolor <- color
color <- "black"
}
pval.font.size <- c(input$pvalfont, input$p_pvalfont, input$p_pvalfont / 10)
pval.coord <- c(input$pvalx, input$pvaly)
Expand Down
72 changes: 66 additions & 6 deletions R/line.R
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,8 @@ lineUI <- function(id, label = "lineplot") {
checkboxInput(ns("label"), "Label"),
uiOutput(ns("pvalue")),
uiOutput(ns("subvar")),
uiOutput(ns("subval"))
uiOutput(ns("subval")),


# uiOutput(ns("size")),
# uiOutput(ns("position.dodge"))
Expand Down Expand Up @@ -175,6 +176,9 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
)
})




output$strata_line <- renderUI({
strata_vars <- setdiff(vlist()$factor_vars, vlist()$except_vars)
strata_vars <- setdiff(strata_vars, input$x_line)
Expand Down Expand Up @@ -264,6 +268,7 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
})



observeEvent(input$subcheck, {
output$subvar <- renderUI({
req(input$subcheck == T)
Expand Down Expand Up @@ -363,8 +368,22 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
outUI
})

y_r <- reactiveVal(NULL)

observeEvent(c(input$isStrata,
input$x_line,
input$y_line,
input$strata,
input$pvalfont,
input$s_pvalue,
input$positiondodge,
input$label), {
y_r(NULL)

})

lineInput <- reactive({
req(c(input$x_line, input$y_line, input$strata, input$pvalfont, input$s_pvalue, input$positiondodge, input$label))
req(c(input$x_line, input$y_line, input$strata, input$pvalfont, input$s_pvalue, input$positiondodge, input$label, input$y_range))
req(input$isStrata != "None")

data <- data.table(data())
Expand Down Expand Up @@ -406,6 +425,7 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
line.point.size <- input$pointsize
pval.font.size <- input$pvalfont


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],
Expand All @@ -414,32 +434,48 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
size = line.size,
point.size = line.point.size,
linetype = linetype

)





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

y_range_internal <- ggplot_build(res.plot)$layout$panel_scales_y[[1]]$range$range

if (input$isStrata & input$strata != "None") {
res.plot <- res.plot +
ggpubr::stat_compare_means(
method = input$s_pvalue,
size = pval.font.size,
label.y = 1.3 * (y_range_internal[2] - y_range_internal[1]) + y_range_internal[1],
#label.y = 1.3 * (input$y_range[2] - input$y_range[1]) + input$y_range[1],
#label.y = 1.3 * (y_r()[2] - y_r()[1]) + y_r()[1],
aes(
label = scales::label_pvalue(add_p = TRUE)(after_stat(p)),
group = !!sym(input$strata)
),
)
)
}

if(!is.null(y_r())){
res.plot <- res.plot + coord_cartesian(ylim = input$y_range)
}



if (input$label) {
if (con3 <- input$strata != "None") {
res.plot <- res.plot +
ggplot2::stat_summary(
fun.data = function(x) {
return(data.frame(y = mean(x), label = round(mean(x), 2)))
},
geom = "label",
geom = "label_repel",
aes(
label = !!sym(input$y_line),
group = !!sym(input$strata)
Expand All @@ -451,16 +487,38 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
fun.data = function(x) {
return(data.frame(y = mean(x), label = round(do.call(add[1], list(x = x))[[1]], 2)))
},
geom = "label",
aes(label = !!sym(input$y_line), )
geom = "label_repel",
aes(label = !!sym(input$y_line))
)
}
}




return(res.plot)
})






observeEvent(lineInput(), {
if(is.null(y_r())){
y_r(ggplot_build(lineInput())$layout$panel_scales_y[[1]]$range$range)
}
})

observeEvent(y_r(),{
if(!is.null(y_r())){
range <- y_r()[2] - y_r()[1]
updateSliderInput(session, "y_range", min = round(y_r()[1] - range * 0.5), max = round(y_r()[2] + range * 0.5), value = y_r())
}
})



output$downloadControls <- renderUI({
tagList(
column(
Expand Down Expand Up @@ -526,6 +584,8 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
column(6, numericInput(session$ns("pointsize"), "Point size", step = 0.5, value = 0.5))
),
sliderInput(session$ns("positiondodge"), "Position dodge", min = 0, max = 1, value = 0),
h3("X - Y range setting"),
sliderInput(session$ns("y_range"), "Y axis range", min = 0, max = 10000, value = c(0, 10000)),
h3("P-value position"),
sliderInput(session$ns("pvalfont"), "P-value font size",
min = 1, max = 10, value = 4
Expand Down

0 comments on commit 5f53f1c

Please sign in to comment.