Skip to content

Commit

Permalink
Merge branch 'master' of https://github.com/jinseob2kim/jsmodule
Browse files Browse the repository at this point in the history
  • Loading branch information
jinseob2kim committed Mar 19, 2024
2 parents 13bad35 + 3b9b978 commit 0a29e9b
Show file tree
Hide file tree
Showing 3 changed files with 93 additions and 72 deletions.
60 changes: 34 additions & 26 deletions R/bar.R
Original file line number Diff line number Diff line change
Expand Up @@ -188,14 +188,14 @@ barServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
tglist <- tagList()

if (vlist()$nclass_factor[input$x_bar] < 3) {
pval.choices <- c("T-test"="t.test", "Wilcoxon"="wilcox.test")
pval.choices <- c("T-test" = "t.test", "Wilcoxon" = "wilcox.test")
} else {
pval.choices <- c("ANOVA"="anova", "Kruskal-Wallis"="kruskal.test")
pval.choices <- c("ANOVA" = "anova", "Kruskal-Wallis" = "kruskal.test")
}

tglist <- tagAppendChildren(
tglist,
div("P value Option") %>% strong,
div("P value Option") %>% strong(),
tabsetPanel(
id = session$ns("side_tabset_pval"),
type = "hidden",
Expand Down Expand Up @@ -250,7 +250,7 @@ barServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
session$ns("p_pvalue"),
label = NULL,
inline = TRUE,
choices = c("T-test"="t_test", "Wilcoxon"="wilcox_test")
choices = c("T-test" = "t_test", "Wilcoxon" = "wilcox_test")
),
),
tabPanel(
Expand Down Expand Up @@ -281,7 +281,7 @@ barServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
session$ns("s_pvalue"),
label = NULL,
inline = TRUE,
choices = c("T-test"="t_test", "Wilcoxon"="wilcox_test")
choices = c("T-test" = "t_test", "Wilcoxon" = "wilcox_test")
)
),
tabPanel(
Expand All @@ -297,21 +297,25 @@ barServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit

# Error message popup
barInputError <- reactive({
msg <- tryCatch({
print(barInput() %>% suppressWarnings)
}, warning = function(e) {
res <- e
temp <- e
while(!is.null(temp$message)) {
res <- temp
temp <- temp$parent
msg <- tryCatch(
{
print(barInput() %>% suppressWarnings())
},
warning = function(e) {
res <- e
temp <- e
while (!is.null(temp$message)) {
res <- temp
temp <- temp$parent
}
return(res$message)
},
error = function(e) {
return(e$message)
}
return(res$message)
}, error = function(e) {
return(e$message)
})
)

ifelse (!is.ggplot(msg), msg, "Success")
ifelse(!is.ggplot(msg), msg, "Success")
})


Expand Down Expand Up @@ -480,11 +484,11 @@ barServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
}

if (is.null(input$pvalfont)) {
pval.font.size <- c(4, 4, 0.4)
pval.coord <- c(0.5, 1)
pval.font.size <- c(4, 4, 0.4)
pval.coord <- c(0.5, 1)
} else {
pval.font.size = c(input$pvalfont, input$p_pvalfont, input$p_pvalfont / 10)
pval.coord = c(input$pvalx, input$pvaly)
pval.font.size <- c(input$pvalfont, input$p_pvalfont, input$p_pvalfont / 10)
pval.coord <- c(input$pvalx, input$pvaly)
}

pval.name <- input$pvalue
Expand Down Expand Up @@ -603,14 +607,18 @@ barServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
tagList(
h3("P-value position"),
sliderInput(session$ns("pvalfont"), "P-value font size",
min = 1, max = 10, value = 4),
min = 1, max = 10, value = 4
),
sliderInput(session$ns("pvalx"), "x-axis",
min = 0, max = 1, value = 0.5),
min = 0, max = 1, value = 0.5
),
sliderInput(session$ns("pvaly"), "y-axis",
min = 0, max = 1, value = 1),
min = 0, max = 1, value = 1
),
h3("Pair P-value position"),
sliderInput(session$ns("p_pvalfont"), "P-value font size",
min = 1, max = 10, value = 4),
min = 1, max = 10, value = 4
),
actionButton(session$ns("pval_reset"), "reset"),
)
})
Expand Down
60 changes: 34 additions & 26 deletions R/box.R
Original file line number Diff line number Diff line change
Expand Up @@ -187,14 +187,14 @@ boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
tglist <- tagList()

if (vlist()$nclass_factor[input$x_box] < 3) {
pval.choices <- c("T-test"="t.test", "Wilcoxon"="wilcox.test")
pval.choices <- c("T-test" = "t.test", "Wilcoxon" = "wilcox.test")
} else {
pval.choices <- c("ANOVA"="anova", "Kruskal-Wallis"="kruskal.test")
pval.choices <- c("ANOVA" = "anova", "Kruskal-Wallis" = "kruskal.test")
}

tglist <- tagAppendChildren(
tglist,
div("P value Option") %>% strong,
div("P value Option") %>% strong(),
tabsetPanel(
id = session$ns("side_tabset_pval"),
type = "hidden",
Expand Down Expand Up @@ -249,7 +249,7 @@ boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
session$ns("p_pvalue"),
label = NULL,
inline = TRUE,
choices = c("T-test"="t_test", "Wilcoxon"="wilcox_test")
choices = c("T-test" = "t_test", "Wilcoxon" = "wilcox_test")
),
),
tabPanel(
Expand Down Expand Up @@ -280,7 +280,7 @@ boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
session$ns("s_pvalue"),
label = NULL,
inline = TRUE,
choices = c("T-test"="t_test", "Wilcoxon"="wilcox_test")
choices = c("T-test" = "t_test", "Wilcoxon" = "wilcox_test")
)
),
tabPanel(
Expand All @@ -296,21 +296,25 @@ boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit

# Error message popup
boxInputError <- reactive({
msg <- tryCatch({
print(boxInput() %>% suppressWarnings)
}, warning = function(e) {
res <- e
temp <- e
while(!is.null(temp$message)) {
res <- temp
temp <- temp$parent
msg <- tryCatch(
{
print(boxInput() %>% suppressWarnings())
},
warning = function(e) {
res <- e
temp <- e
while (!is.null(temp$message)) {
res <- temp
temp <- temp$parent
}
return(res$message)
},
error = function(e) {
return(e$message)
}
return(res$message)
}, error = function(e) {
return(e$message)
})
)

ifelse (!is.ggplot(msg), msg, "Success")
ifelse(!is.ggplot(msg), msg, "Success")
})


Expand Down Expand Up @@ -472,11 +476,11 @@ boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
fillcolor <- "gray"
}
if (is.null(input$pvalfont)) {
pval.font.size <- c(4, 4, 0.4)
pval.coord <- c(0.5, 1)
pval.font.size <- c(4, 4, 0.4)
pval.coord <- c(0.5, 1)
} else {
pval.font.size = c(input$pvalfont, input$p_pvalfont, input$p_pvalfont / 10)
pval.coord = c(input$pvalx, input$pvaly)
pval.font.size <- c(input$pvalfont, input$p_pvalfont, input$p_pvalfont / 10)
pval.coord <- c(input$pvalx, input$pvaly)
}
pval.name <- input$pvalue
ppval.name <- input$p_pvalue
Expand Down Expand Up @@ -594,14 +598,18 @@ boxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit
tagList(
h3("P-value position"),
sliderInput(session$ns("pvalfont"), "P-value font size",
min = 1, max = 10, value = 4),
min = 1, max = 10, value = 4
),
sliderInput(session$ns("pvalx"), "x-axis",
min = 0, max = 1, value = 0.5),
min = 0, max = 1, value = 0.5
),
sliderInput(session$ns("pvaly"), "y-axis",
min = 0, max = 1, value = 1),
min = 0, max = 1, value = 1
),
h3("Pair P-value position"),
sliderInput(session$ns("p_pvalfont"), "P-value font size",
min = 1, max = 10, value = 4),
min = 1, max = 10, value = 4
),
actionButton(session$ns("pval_reset"), "reset"),
)
})
Expand Down
45 changes: 25 additions & 20 deletions R/line.R
Original file line number Diff line number Diff line change
Expand Up @@ -190,17 +190,17 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
tglist <- tagList()
if (input$strata != "None") {
if (vlist()$nclass_factor[input$strata] < 3) {
pval.choices <- c("T-test"="t.test", "Wilcoxon"="wilcox.test")
pval.choices <- c("T-test" = "t.test", "Wilcoxon" = "wilcox.test")
} else {
pval.choices <- c("ANOVA"="anova", "Kruskal-Wallis"="kruskal.test")
pval.choices <- c("ANOVA" = "anova", "Kruskal-Wallis" = "kruskal.test")
}
} else {
pval.choices <- c("ANOVA"="anova", "Kruskal-Wallis"="kruskal.test")
pval.choices <- c("ANOVA" = "anova", "Kruskal-Wallis" = "kruskal.test")
}

tglist <- tagAppendChildren(
tglist,
div("P value Option") %>% strong,
div("P value Option") %>% strong(),
tabsetPanel(
id = session$ns("side_tabset_isstrata"),
type = "hidden",
Expand Down Expand Up @@ -239,21 +239,25 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi


lineInputError <- reactive({
msg <- tryCatch({
print(lineInput() %>% suppressWarnings)
}, warning = function(e) {
res <- e
temp <- e
while(!is.null(temp$message)) {
res <- temp
temp <- temp$parent
msg <- tryCatch(
{
print(lineInput() %>% suppressWarnings())
},
warning = function(e) {
res <- e
temp <- e
while (!is.null(temp$message)) {
res <- temp
temp <- temp$parent
}
return(res$message)
},
error = function(e) {
return(e$message)
}
return(res$message)
}, error = function(e) {
return(e$message)
})
)

ifelse (!is.ggplot(msg), msg, "Success")
ifelse(!is.ggplot(msg), msg, "Success")
})


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

if (is.null(input$pvalfont)) {
pval.font.size <- 4
pval.font.size <- 4
} else {
pval.font.size = input$pvalfont
pval.font.size <- input$pvalfont
}
spval.name <- input$s_pvalue

Expand Down Expand Up @@ -503,7 +507,8 @@ lineServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limi
sliderInput(session$ns("positiondodge"), "Position dodge", min = 0, max = 1, value = 0),
h3("P-value position"),
sliderInput(session$ns("pvalfont"), "P-value font size",
min = 1, max = 10, value = 4),
min = 1, max = 10, value = 4
),
actionButton(session$ns("pval_reset"), "reset")
)
})
Expand Down

0 comments on commit 0a29e9b

Please sign in to comment.