选择输入启用或禁用操作按钮 - 有问题
Selectinput enable or disable actionbuttons - has problems
我找到了解决方案,但我的代码有问题。
我从 shinyjs 包中找到这个解决方案
前一题可以在这里查看
How to deal with this: A input window and 2 or more actionbutton but different input selected
##########
下面是我的代码,不完整
options(encoding = "UTF-8")
library(stats)
library(openxlsx)
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra) ## inline the all the plot
library(ggpubr)
library(shinythemes)
library(shinymanager)
library(psych)
library(DT)
library(shinyjs)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
# Prepare dataset.
# 1. Bind mean and sd data
# 2. Reshape
data <- bind_rows(list(
mean = mean_data,
sd = sd_data
), .id = "stat")
data_mean_sd <- data %>%
pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
pivot_wider(names_from = "stat", values_from = "value")
data_mean_sd2<-data_mean_sd[data_mean_sd$Gene==paste0("Gene_",1:25),]
###
ui <- fluidPage(
shinyjs::useShinyjs(),
fluidRow(
column(8,offset = 3,
h2("Gene_FPKM Value Barplot")
)
),
fluidRow(
column(8,offset = 3,
selectInput(
"selectGeneSymbol",
"Select Gene Symbol:",
choices = unique(data_mean_sd$Gene),
multiple =F,
width = 800,
selected = "Igfbp7"
))
),
fluidRow(
column(8,offset = 3,
actionButton(inputId = "plot1", label = "FPKM",width=80),
actionButton(inputId = "plot2", label = "LogFc",width=80),
actionButton(inputId = "all",label = "FPKM&LogFc",width=120)
)
),
fluidRow(
column(3)
),
fluidRow(
column(3)
),
fluidRow(
column(12,align="center",
uiOutput("all")
)
)
)
server <- function(input, output,session) {
observeEvent(input$plot2,input$all, {
if(input$selectGeneSymbol %in% unique(data_mean_sd2$Gene)){
shinyjs::enable("plot2")
shinyjs::enable("all")
}else{
shinyjs::disable("plot2")
shinyjs::disable("all")
}
})
plot_data1 <- eventReactive(input$plot1, {
subset(data_mean_sd, Gene %in% input$selectGeneSymbol)
})
plot_data2 <- eventReactive(input$plot2, {
subset(data_mean_sd2, Gene %in% input$selectGeneSymbol)
})
global <- reactiveValues(out = NULL)
observeEvent(input$plot1, {
global$out <- plotOutput("plot1", height=600)
})
observeEvent(input$plot2, {
global$out <- plotOutput("plot2", height=600)
})
observeEvent(input$all, {
global$out <- plotOutput("plot3", height=800)
})
output$all <- renderUI({
global$out
})
p1 <- eventReactive(list(input$plot1,
input$all), {
ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
p2 <- eventReactive(list(input$plot2,
input$all), {
ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$plot1 <- renderPlot({ p1() })
output$plot2 <- renderPlot({ p2() })
output$plot3 <- renderPlot({ grid.arrange(p1(),p2(), ncol=1) })
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
当我 运行 我的代码:
错误:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
有人可以帮助我吗?
编辑:2021-03-17 17:26:03:
我刚刚改进了我的代码,它可以更好地工作但并不完美。
就像这样:
observeEvent(input$plot2, {
if(input$selectGeneSymbol %in% unique(data_mean_sd2$Gene)){
shinyjs::enable("plot2")
global$out <- plotOutput("plot2", height=600)
}else{
shinyjs::disable("plot2")
}
})
observeEvent(input$all, {
if(input$selectGeneSymbol %in% unique(data_mean_sd2$Gene)){
shinyjs::enable("all")
global$out <- plotOutput("plot3", height=800)
}else{
shinyjs::disable("all")
}
})
如果有人输入基因符号,如果它只在 data_mean_sd2.
中,则可以禁用操作按钮
但是我遇到了一个新问题,尽管我 select 一个新基因,但禁用的操作按钮仍然处于禁用状态。所以下一步我必须修改我的代码。
试试这个
ui <- fluidPage(
shinyjs::useShinyjs(),
fluidRow(
column(8,offset = 3,
h2("Gene_FPKM Value Barplot")
)
),
fluidRow(
column(8,offset = 3,
selectInput(
"selectGeneSymbol",
"Select Gene Symbol:",
choices = unique(data_mean_sd$Gene),
multiple =F,
width = 800,
selected = "Igfbp7"
))
),
fluidRow(
column(8,offset = 3,
actionButton(inputId = "plot1", label = "FPKM",width=80),
actionButton(inputId = "plot2", label = "LogFc",width=80),
actionButton(inputId = "all",label = "FPKM&LogFc",width=120)
)
),
fluidRow(
column(3)
),
fluidRow(
column(3)
),
fluidRow(
column(12,align="center",
uiOutput("plots")
)
)
)
server <- function(input, output,session) {
observeEvent(input$selectGeneSymbol, {
if(sum(unique(data_mean_sd2$Gene) %in% input$selectGeneSymbol)>0) {
shinyjs::enable("plot2")
shinyjs::enable("all")
}else{
shinyjs::disable("plot2")
shinyjs::disable("all")
}
})
plot_data1 <- eventReactive(list(input$plot1,input$all), {
subset(data_mean_sd, Gene %in% input$selectGeneSymbol)
})
plot_data2 <- eventReactive(list(input$plot2,input$all), {
subset(data_mean_sd2, Gene %in% input$selectGeneSymbol)
})
global <- reactiveValues()
observeEvent(list(input$plot1,input$all), {
req(plot_data1())
#p1 <- eventReactive(list(input$plot1,
# input$all), {
global$p1 <- ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
observeEvent(list(input$plot2,input$all), {
req(plot_data2())
#p2 <- eventReactive(list(input$plot2,
# input$all), {
global$p2 <- ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$plt1 <- renderPlot({ global$p1 })
output$plt2 <- renderPlot({ global$p2 })
output$plt3 <- renderPlot({ grid.arrange(global$p1,global$p2, ncol=1) })
observeEvent(input$plot1, {
global$out <- plotOutput("plt1", height=600)
})
observeEvent(input$plot2, {
global$out <- plotOutput("plt2", height=600)
})
observeEvent(input$all, {
global$out <- plotOutput("plt3", height=800)
})
output$plots <- renderUI({
global$out
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
我找到了解决方案,但我的代码有问题。
我从 shinyjs 包中找到这个解决方案
前一题可以在这里查看
How to deal with this: A input window and 2 or more actionbutton but different input selected
##########
下面是我的代码,不完整
options(encoding = "UTF-8")
library(stats)
library(openxlsx)
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra) ## inline the all the plot
library(ggpubr)
library(shinythemes)
library(shinymanager)
library(psych)
library(DT)
library(shinyjs)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
# Prepare dataset.
# 1. Bind mean and sd data
# 2. Reshape
data <- bind_rows(list(
mean = mean_data,
sd = sd_data
), .id = "stat")
data_mean_sd <- data %>%
pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
pivot_wider(names_from = "stat", values_from = "value")
data_mean_sd2<-data_mean_sd[data_mean_sd$Gene==paste0("Gene_",1:25),]
###
ui <- fluidPage(
shinyjs::useShinyjs(),
fluidRow(
column(8,offset = 3,
h2("Gene_FPKM Value Barplot")
)
),
fluidRow(
column(8,offset = 3,
selectInput(
"selectGeneSymbol",
"Select Gene Symbol:",
choices = unique(data_mean_sd$Gene),
multiple =F,
width = 800,
selected = "Igfbp7"
))
),
fluidRow(
column(8,offset = 3,
actionButton(inputId = "plot1", label = "FPKM",width=80),
actionButton(inputId = "plot2", label = "LogFc",width=80),
actionButton(inputId = "all",label = "FPKM&LogFc",width=120)
)
),
fluidRow(
column(3)
),
fluidRow(
column(3)
),
fluidRow(
column(12,align="center",
uiOutput("all")
)
)
)
server <- function(input, output,session) {
observeEvent(input$plot2,input$all, {
if(input$selectGeneSymbol %in% unique(data_mean_sd2$Gene)){
shinyjs::enable("plot2")
shinyjs::enable("all")
}else{
shinyjs::disable("plot2")
shinyjs::disable("all")
}
})
plot_data1 <- eventReactive(input$plot1, {
subset(data_mean_sd, Gene %in% input$selectGeneSymbol)
})
plot_data2 <- eventReactive(input$plot2, {
subset(data_mean_sd2, Gene %in% input$selectGeneSymbol)
})
global <- reactiveValues(out = NULL)
observeEvent(input$plot1, {
global$out <- plotOutput("plot1", height=600)
})
observeEvent(input$plot2, {
global$out <- plotOutput("plot2", height=600)
})
observeEvent(input$all, {
global$out <- plotOutput("plot3", height=800)
})
output$all <- renderUI({
global$out
})
p1 <- eventReactive(list(input$plot1,
input$all), {
ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
p2 <- eventReactive(list(input$plot2,
input$all), {
ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$plot1 <- renderPlot({ p1() })
output$plot2 <- renderPlot({ p2() })
output$plot3 <- renderPlot({ grid.arrange(p1(),p2(), ncol=1) })
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
当我 运行 我的代码:
错误:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
有人可以帮助我吗?
编辑:2021-03-17 17:26:03:
我刚刚改进了我的代码,它可以更好地工作但并不完美。 就像这样:
observeEvent(input$plot2, {
if(input$selectGeneSymbol %in% unique(data_mean_sd2$Gene)){
shinyjs::enable("plot2")
global$out <- plotOutput("plot2", height=600)
}else{
shinyjs::disable("plot2")
}
})
observeEvent(input$all, {
if(input$selectGeneSymbol %in% unique(data_mean_sd2$Gene)){
shinyjs::enable("all")
global$out <- plotOutput("plot3", height=800)
}else{
shinyjs::disable("all")
}
})
如果有人输入基因符号,如果它只在 data_mean_sd2.
中,则可以禁用操作按钮
但是我遇到了一个新问题,尽管我 select 一个新基因,但禁用的操作按钮仍然处于禁用状态。所以下一步我必须修改我的代码。
试试这个
ui <- fluidPage(
shinyjs::useShinyjs(),
fluidRow(
column(8,offset = 3,
h2("Gene_FPKM Value Barplot")
)
),
fluidRow(
column(8,offset = 3,
selectInput(
"selectGeneSymbol",
"Select Gene Symbol:",
choices = unique(data_mean_sd$Gene),
multiple =F,
width = 800,
selected = "Igfbp7"
))
),
fluidRow(
column(8,offset = 3,
actionButton(inputId = "plot1", label = "FPKM",width=80),
actionButton(inputId = "plot2", label = "LogFc",width=80),
actionButton(inputId = "all",label = "FPKM&LogFc",width=120)
)
),
fluidRow(
column(3)
),
fluidRow(
column(3)
),
fluidRow(
column(12,align="center",
uiOutput("plots")
)
)
)
server <- function(input, output,session) {
observeEvent(input$selectGeneSymbol, {
if(sum(unique(data_mean_sd2$Gene) %in% input$selectGeneSymbol)>0) {
shinyjs::enable("plot2")
shinyjs::enable("all")
}else{
shinyjs::disable("plot2")
shinyjs::disable("all")
}
})
plot_data1 <- eventReactive(list(input$plot1,input$all), {
subset(data_mean_sd, Gene %in% input$selectGeneSymbol)
})
plot_data2 <- eventReactive(list(input$plot2,input$all), {
subset(data_mean_sd2, Gene %in% input$selectGeneSymbol)
})
global <- reactiveValues()
observeEvent(list(input$plot1,input$all), {
req(plot_data1())
#p1 <- eventReactive(list(input$plot1,
# input$all), {
global$p1 <- ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
observeEvent(list(input$plot2,input$all), {
req(plot_data2())
#p2 <- eventReactive(list(input$plot2,
# input$all), {
global$p2 <- ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
theme(axis.text.x=element_text(vjust=1,size=12))
})
output$plt1 <- renderPlot({ global$p1 })
output$plt2 <- renderPlot({ global$p2 })
output$plt3 <- renderPlot({ grid.arrange(global$p1,global$p2, ncol=1) })
observeEvent(input$plot1, {
global$out <- plotOutput("plt1", height=600)
})
observeEvent(input$plot2, {
global$out <- plotOutput("plt2", height=600)
})
observeEvent(input$all, {
global$out <- plotOutput("plt3", height=800)
})
output$plots <- renderUI({
global$out
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)