如何将元素添加到图中并在单击操作按钮后查看更新？ [闪亮的]
How to add elements into a plot and see the update after having clicked the actionButton? [Shiny]
我正在尝试创建一个应用程序，您可以在其中创建箱线图并在用户选择时添加 Kruskal-Wallis p 值。
该应用有 3 个标签：
- Tab 1 > 它有一个
checkboxInput 如果你点击它，你将进行 log2 转换。此外，它还有一个 actionButton 来提交您的数据（有或没有 log2）。不点按钮就画不出来
- Tab 2 > 它有
radioButtons 和 checkboxInput 允许您根据用户的选择绘制不同的图。
- Tab 3 > 它有一个
numericInput 允许您更改绘图的不透明度。此外，它还有一个 checkboxInput 允许您将 Kruskal-Wallis p 值添加到图中。
效果很好。但是，当我想添加 KW p 值时，该值会在单击 actionButton.
之前自行更改
这是当您选择了 2 个组并单击选项卡 3 中的 checkboxInput 以显示 KW pvalue 时的样子。
但是，如果您取消选择第 1 组，为了只看到第 3 组，在单击 actionButton 之前，p 值的位置会发生变化。
然后，当您单击该按钮时，您将获得预期的最终输出。
另一方面，如果用户决定更改 p 值的位置（通过单击“显示 Kruskal Wallis p 值”后出现的 numericInputs），该图无需更改即可更新单击 actionButton.
总之，问题是点击actionButton之前剧情更新了，不知道怎么解决
请注意，如果您更改绘图的不透明度，除非您单击 actionButton（我希望所有应用程序都这样做），否则绘图不会更改。
有人知道怎么解决吗？
提前致谢
代码：
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Tab1",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Tab2",
radioButtons(inputId = "plot_type", label = "I want to see the plot of:",
c("All the samples" = "all_samples",
"Groups" = "samples_group")),
conditionalPanel(
condition = "input.plot_type == 'samples_group'",
style = "margin-left: 20px;",
checkboxGroupInput("group", "Choose the group:",
choices = c("Group1", "Group2", "Group3"))),
actionButton("show_plot", "See the plot")
),
tabPanel("Tab3",
numericInput("alpha", "Opacity of the plot", value=0.2),
checkboxInput(inputId = "Kruskalpval", label = "Show the Kruskal Wallis p-value", value = FALSE),
conditionalPanel(
condition = "input.Kruskalpval == '1'",
style = "margin-left: 20px;",
checkboxInput(inputId = "changeKW", "I want to change the place of the value", value=FALSE),
conditionalPanel(
condition = "input.changeKW == '1'",
numericInput(inputId = "X_axis", "X_axis:", value=2),
numericInput(inputId = "Y_axis", "Y_axis:", value=70)
)
),
actionButton("show_plot_2", "See the plot")
)
)
),
mainPanel(
plotOutput("boxplots")
)
)
)
server <- function(input, output) {
set.seed(1234)
Gene <- floor(runif(25, min=0, max=101))
groups_age <- floor(runif(25, min=18, max=75))
Group <- c("Group1", "Group1", "Group3", "Group2", "Group1", "Group3", "Group2", "Group2", "Group2", "Group1", "Group1", "Group3", "Group1", "Group2", "Group1", "Group2", "Group3", "Group1", "Group3", "Group3", "Group2", "Group1", "Group3", "Group3","Group2")
data <- reactive({
df <- data.frame(Gene, Group, groups_age)
mybreaks <- seq(min(df$groups_age)-1, to=max(df$groups_age)+10, by=10)
df$groups_age <- cut(df$groups_age, breaks = mybreaks, by=10)
if(input$plot_type == "samples_group"){
# if the user selects everything, it will take everything.
if(all(c("Group1", "Group2", "Group3") %in% input$group)){
return(df)
# if the user only selects group1 and group2, it will appear only those columns.
}else if (all(c("Group1", "Group2") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group2"))
return(df)
# if the user only selects group1 and group3, it will appear only those columns.
}else if (all(c("Group1", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group3"))
return(df)
# if the user only selects Group2 and Group3, it will appear only those columns.
}else if (all(c("Group2", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group2" | df$Group == "Group3"))
return(df)
# if the user only selects Group1
} else if ("Group1" %in% input$group) {
df <- subset(df, (df$Group == "Group1"))
return(df)
# if the user only selects group2
} else if ("Group2" %in% input$group) {
df <- subset(df, (df$Group == "Group2"))
return(df)
# if the user only selects group3
} else if ("Group3" %in% input$group) {
df <- subset(df, (df$Group == "Group3"))
return(df)
# if the user doesn't select anything.
} else {
return(df)
}
}else{
df$Group <- NULL
return(df)
}
})
mydata <- reactive({
req(input$submit)
if(input$log2 == TRUE){
data <- data()
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
else{
data <- data()
}
return(data)
})
draw_bp <- reactive({
if(ncol(mydata())==2){
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha = input$alpha) +
labs(fill = "groups_age")
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=input$X_axis, y=input$Y_axis, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
else{
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha=input$alpha) +
facet_grid(. ~ Group)
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=input$X_axis, y=input$Y_axis, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
})
v <- reactiveValues()
observeEvent(input$show_plot | input$show_plot_2, {
v$plot <- draw_bp()
})
output$boxplots <- renderPlot({
req(input$submit)
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui = ui, server = server)
正如@YBS 在评论中建议的那样，我们可以在创建反应式 data:
时使用 eventReactive
data <- eventReactive(c(input$show_plot, input$show_plot_2), {.....})
完整代码：
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel(
"Tab1",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel(
"Tab2",
radioButtons(
inputId = "plot_type", label = "I want to see the plot of:",
c(
"All the samples" = "all_samples",
"Groups" = "samples_group"
)
),
conditionalPanel(
condition = "input.plot_type == 'samples_group'",
style = "margin-left: 20px;",
checkboxGroupInput("group", "Choose the group:",
choices = c("Group1", "Group2", "Group3")
)
),
actionButton("show_plot", "See the plot")
),
tabPanel(
"Tab3",
numericInput("alpha", "Opacity of the plot", value = 0.2),
checkboxInput(inputId = "Kruskalpval", label = "Show the Kruskal Wallis p-value", value = FALSE),
conditionalPanel(
condition = "input.Kruskalpval == '1'",
style = "margin-left: 20px;",
checkboxInput(inputId = "changeKW", "I want to change the place of the value", value = FALSE),
conditionalPanel(
condition = "input.changeKW == '1'",
numericInput(inputId = "X_axis", "X_axis:", value = 2),
numericInput(inputId = "Y_axis", "Y_axis:", value = 70)
)
),
actionButton("show_plot_2", "See the plot")
)
)
),
mainPanel(
plotOutput("boxplots")
)
)
)
server <- function(input, output) {
set.seed(1234)
Gene <- floor(runif(25, min=0, max=101))
groups_age <- floor(runif(25, min=18, max=75))
Group <- c("Group1", "Group1", "Group3", "Group2", "Group1", "Group3", "Group2", "Group2", "Group2", "Group1", "Group1", "Group3", "Group1", "Group2", "Group1", "Group2", "Group3", "Group1", "Group3", "Group3", "Group2", "Group1", "Group3", "Group3","Group2")
data <- eventReactive(c(input$show_plot, input$show_plot_2), {
df <- data.frame(Gene, Group, groups_age)
mybreaks <- seq(min(df$groups_age)-1, to=max(df$groups_age)+10, by=10)
df$groups_age <- cut(df$groups_age, breaks = mybreaks, by=10)
if(input$plot_type == "samples_group"){
# if the user selects everything, it will take everything.
if(all(c("Group1", "Group2", "Group3") %in% input$group)){
return(df)
# if the user only selects group1 and group2, it will appear only those columns.
}else if (all(c("Group1", "Group2") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group2"))
return(df)
# if the user only selects group1 and group3, it will appear only those columns.
}else if (all(c("Group1", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group3"))
return(df)
# if the user only selects Group2 and Group3, it will appear only those columns.
}else if (all(c("Group2", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group2" | df$Group == "Group3"))
return(df)
# if the user only selects Group1
} else if ("Group1" %in% input$group) {
df <- subset(df, (df$Group == "Group1"))
return(df)
# if the user only selects group2
} else if ("Group2" %in% input$group) {
df <- subset(df, (df$Group == "Group2"))
return(df)
# if the user only selects group3
} else if ("Group3" %in% input$group) {
df <- subset(df, (df$Group == "Group3"))
return(df)
# if the user doesn't select anything.
} else {
return(df)
}
}else{
df$Group <- NULL
return(df)
}
})
mydata <- reactive({
req(input$submit)
if(input$log2 == TRUE){
data <- data()
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
else{
data <- data()
}
return(data)
})
draw_bp <- reactive({
if(ncol(mydata())==2){
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha = input$alpha) +
labs(fill = "groups_age")
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=input$X_axis, y=input$Y_axis, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
else{
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha=input$alpha) +
facet_grid(. ~ Group)
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=input$X_axis, y=input$Y_axis, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
})
v <- reactiveValues()
observeEvent(input$show_plot | input$show_plot_2, {
v$plot <- draw_bp()
})
output$boxplots <- renderPlot({
req(input$submit)
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui = ui, server = server)
您需要使用 isolate() 作为数字输入，这样它们就不会在不单击 actionButton 的情况下更新 KW 的位置。另外，不需要 observeEvent()。试试这个
draw_bp <- eventReactive(c(input$show_plot, input$show_plot_2), {
if(ncol(mydata())==2){
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha = input$alpha) +
labs(fill = "groups_age")
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
else{
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha=input$alpha) +
facet_grid(. ~ Group)
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
})
v <- reactiveValues()
observeEvent(input$show_plot | input$show_plot_2, {
v$plot <- draw_bp()
})
output$boxplots <- renderPlot({
req(input$submit)
# if (is.null(v$plot)) return()
# v$plot
draw_bp()
})
我正在尝试创建一个应用程序，您可以在其中创建箱线图并在用户选择时添加 Kruskal-Wallis p 值。
该应用有 3 个标签：
- Tab 1 > 它有一个
checkboxInput如果你点击它，你将进行 log2 转换。此外，它还有一个actionButton来提交您的数据（有或没有 log2）。不点按钮就画不出来 - Tab 2 > 它有
radioButtons和checkboxInput允许您根据用户的选择绘制不同的图。 - Tab 3 > 它有一个
numericInput允许您更改绘图的不透明度。此外，它还有一个checkboxInput允许您将 Kruskal-Wallis p 值添加到图中。
效果很好。但是，当我想添加 KW p 值时，该值会在单击 actionButton.
这是当您选择了 2 个组并单击选项卡 3 中的 checkboxInput 以显示 KW pvalue 时的样子。
但是，如果您取消选择第 1 组，为了只看到第 3 组，在单击 actionButton 之前，p 值的位置会发生变化。
然后，当您单击该按钮时，您将获得预期的最终输出。
另一方面，如果用户决定更改 p 值的位置（通过单击“显示 Kruskal Wallis p 值”后出现的 numericInputs），该图无需更改即可更新单击 actionButton.
总之，问题是点击actionButton之前剧情更新了，不知道怎么解决
请注意，如果您更改绘图的不透明度，除非您单击 actionButton（我希望所有应用程序都这样做），否则绘图不会更改。
有人知道怎么解决吗？
提前致谢
代码：
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Tab1",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Tab2",
radioButtons(inputId = "plot_type", label = "I want to see the plot of:",
c("All the samples" = "all_samples",
"Groups" = "samples_group")),
conditionalPanel(
condition = "input.plot_type == 'samples_group'",
style = "margin-left: 20px;",
checkboxGroupInput("group", "Choose the group:",
choices = c("Group1", "Group2", "Group3"))),
actionButton("show_plot", "See the plot")
),
tabPanel("Tab3",
numericInput("alpha", "Opacity of the plot", value=0.2),
checkboxInput(inputId = "Kruskalpval", label = "Show the Kruskal Wallis p-value", value = FALSE),
conditionalPanel(
condition = "input.Kruskalpval == '1'",
style = "margin-left: 20px;",
checkboxInput(inputId = "changeKW", "I want to change the place of the value", value=FALSE),
conditionalPanel(
condition = "input.changeKW == '1'",
numericInput(inputId = "X_axis", "X_axis:", value=2),
numericInput(inputId = "Y_axis", "Y_axis:", value=70)
)
),
actionButton("show_plot_2", "See the plot")
)
)
),
mainPanel(
plotOutput("boxplots")
)
)
)
server <- function(input, output) {
set.seed(1234)
Gene <- floor(runif(25, min=0, max=101))
groups_age <- floor(runif(25, min=18, max=75))
Group <- c("Group1", "Group1", "Group3", "Group2", "Group1", "Group3", "Group2", "Group2", "Group2", "Group1", "Group1", "Group3", "Group1", "Group2", "Group1", "Group2", "Group3", "Group1", "Group3", "Group3", "Group2", "Group1", "Group3", "Group3","Group2")
data <- reactive({
df <- data.frame(Gene, Group, groups_age)
mybreaks <- seq(min(df$groups_age)-1, to=max(df$groups_age)+10, by=10)
df$groups_age <- cut(df$groups_age, breaks = mybreaks, by=10)
if(input$plot_type == "samples_group"){
# if the user selects everything, it will take everything.
if(all(c("Group1", "Group2", "Group3") %in% input$group)){
return(df)
# if the user only selects group1 and group2, it will appear only those columns.
}else if (all(c("Group1", "Group2") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group2"))
return(df)
# if the user only selects group1 and group3, it will appear only those columns.
}else if (all(c("Group1", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group3"))
return(df)
# if the user only selects Group2 and Group3, it will appear only those columns.
}else if (all(c("Group2", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group2" | df$Group == "Group3"))
return(df)
# if the user only selects Group1
} else if ("Group1" %in% input$group) {
df <- subset(df, (df$Group == "Group1"))
return(df)
# if the user only selects group2
} else if ("Group2" %in% input$group) {
df <- subset(df, (df$Group == "Group2"))
return(df)
# if the user only selects group3
} else if ("Group3" %in% input$group) {
df <- subset(df, (df$Group == "Group3"))
return(df)
# if the user doesn't select anything.
} else {
return(df)
}
}else{
df$Group <- NULL
return(df)
}
})
mydata <- reactive({
req(input$submit)
if(input$log2 == TRUE){
data <- data()
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
else{
data <- data()
}
return(data)
})
draw_bp <- reactive({
if(ncol(mydata())==2){
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha = input$alpha) +
labs(fill = "groups_age")
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=input$X_axis, y=input$Y_axis, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
else{
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha=input$alpha) +
facet_grid(. ~ Group)
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=input$X_axis, y=input$Y_axis, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
})
v <- reactiveValues()
observeEvent(input$show_plot | input$show_plot_2, {
v$plot <- draw_bp()
})
output$boxplots <- renderPlot({
req(input$submit)
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui = ui, server = server)
正如@YBS 在评论中建议的那样，我们可以在创建反应式 data:
eventReactive
data <- eventReactive(c(input$show_plot, input$show_plot_2), {.....})
完整代码：
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel(
"Tab1",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel(
"Tab2",
radioButtons(
inputId = "plot_type", label = "I want to see the plot of:",
c(
"All the samples" = "all_samples",
"Groups" = "samples_group"
)
),
conditionalPanel(
condition = "input.plot_type == 'samples_group'",
style = "margin-left: 20px;",
checkboxGroupInput("group", "Choose the group:",
choices = c("Group1", "Group2", "Group3")
)
),
actionButton("show_plot", "See the plot")
),
tabPanel(
"Tab3",
numericInput("alpha", "Opacity of the plot", value = 0.2),
checkboxInput(inputId = "Kruskalpval", label = "Show the Kruskal Wallis p-value", value = FALSE),
conditionalPanel(
condition = "input.Kruskalpval == '1'",
style = "margin-left: 20px;",
checkboxInput(inputId = "changeKW", "I want to change the place of the value", value = FALSE),
conditionalPanel(
condition = "input.changeKW == '1'",
numericInput(inputId = "X_axis", "X_axis:", value = 2),
numericInput(inputId = "Y_axis", "Y_axis:", value = 70)
)
),
actionButton("show_plot_2", "See the plot")
)
)
),
mainPanel(
plotOutput("boxplots")
)
)
)
server <- function(input, output) {
set.seed(1234)
Gene <- floor(runif(25, min=0, max=101))
groups_age <- floor(runif(25, min=18, max=75))
Group <- c("Group1", "Group1", "Group3", "Group2", "Group1", "Group3", "Group2", "Group2", "Group2", "Group1", "Group1", "Group3", "Group1", "Group2", "Group1", "Group2", "Group3", "Group1", "Group3", "Group3", "Group2", "Group1", "Group3", "Group3","Group2")
data <- eventReactive(c(input$show_plot, input$show_plot_2), {
df <- data.frame(Gene, Group, groups_age)
mybreaks <- seq(min(df$groups_age)-1, to=max(df$groups_age)+10, by=10)
df$groups_age <- cut(df$groups_age, breaks = mybreaks, by=10)
if(input$plot_type == "samples_group"){
# if the user selects everything, it will take everything.
if(all(c("Group1", "Group2", "Group3") %in% input$group)){
return(df)
# if the user only selects group1 and group2, it will appear only those columns.
}else if (all(c("Group1", "Group2") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group2"))
return(df)
# if the user only selects group1 and group3, it will appear only those columns.
}else if (all(c("Group1", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group3"))
return(df)
# if the user only selects Group2 and Group3, it will appear only those columns.
}else if (all(c("Group2", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group2" | df$Group == "Group3"))
return(df)
# if the user only selects Group1
} else if ("Group1" %in% input$group) {
df <- subset(df, (df$Group == "Group1"))
return(df)
# if the user only selects group2
} else if ("Group2" %in% input$group) {
df <- subset(df, (df$Group == "Group2"))
return(df)
# if the user only selects group3
} else if ("Group3" %in% input$group) {
df <- subset(df, (df$Group == "Group3"))
return(df)
# if the user doesn't select anything.
} else {
return(df)
}
}else{
df$Group <- NULL
return(df)
}
})
mydata <- reactive({
req(input$submit)
if(input$log2 == TRUE){
data <- data()
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
else{
data <- data()
}
return(data)
})
draw_bp <- reactive({
if(ncol(mydata())==2){
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha = input$alpha) +
labs(fill = "groups_age")
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=input$X_axis, y=input$Y_axis, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
else{
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha=input$alpha) +
facet_grid(. ~ Group)
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=input$X_axis, y=input$Y_axis, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
})
v <- reactiveValues()
observeEvent(input$show_plot | input$show_plot_2, {
v$plot <- draw_bp()
})
output$boxplots <- renderPlot({
req(input$submit)
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui = ui, server = server)
您需要使用 isolate() 作为数字输入，这样它们就不会在不单击 actionButton 的情况下更新 KW 的位置。另外，不需要 observeEvent()。试试这个
draw_bp <- eventReactive(c(input$show_plot, input$show_plot_2), {
if(ncol(mydata())==2){
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha = input$alpha) +
labs(fill = "groups_age")
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
else{
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
geom_boxplot(aes(fill=groups_age), alpha=input$alpha) +
facet_grid(. ~ Group)
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp + geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
})
v <- reactiveValues()
observeEvent(input$show_plot | input$show_plot_2, {
v$plot <- draw_bp()
})
output$boxplots <- renderPlot({
req(input$submit)
# if (is.null(v$plot)) return()
# v$plot
draw_bp()
})