'How to refresh result completely by different actionbuttons in shiny
My shiny app works well but there is a small problem that puzzled me.
There are three actionbuttons and all of them can create similar pictures and tables at the same time.
In my view, I hope each actionbutton can refresh the result generated by last button. I modified my code but it doesn't work. And one or two empty area always appear.
So my question is what I can do to remove the empty areas. I hope each graph and each table could appear together without any space or distance just like the result that the first button generated.
The space like this:
Here is my code:
options(encoding = "UTF-8")
library(shiny)
library(shinythemes)
library(psych) ## corr.test
library(DT)
library(pheatmap)
########
data<-structure(list(Name = c("A", "A", "A", "B", "B", "B", "C", "C",
"C", "D"), `0610005C13Rik` = c(0.42, 0.28, 0.16, 0.14, 0.23,
0.12, 0, 0.06, 0.09, 0.27), `0610006L08Rik` = c(0, 0, 0, 0, 0,
0, 0, 0, 0, 0), `0610007P14Rik` = c(12.81, 11.44, 13.94, 14.26,
14.95, 14.55, 6.61, 8.52, 7.68, 5.13), `0610009B22Rik` = c(7.53,
6.55, 7.32, 7.12, 6.33, 7.12, 5.87, 3.57, 3.95, 3.49), `0610009E02Rik` = c(0.19,
0.25, 0.23, 0.18, 0.28, 0.3, 0.26, 0.14, 0.11, 0.11), `0610009L18Rik` = c(1.32,
1.61, 1.26, 0.78, 1.12, 0.95, 3.45, 1.36, 0.94, 1.31), `0610009O20Rik` = c(18.73,
17.38, 18.56, 21.46, 22.64, 21.24, 20.85, 21.85, 17.9, 23.44),
`0610010B08Rik` = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), `0610010F05Rik` = c(5.14,
4.49, 4.68, 4.63, 4.5, 4.15, 1.74, 2.3, 2.03, 2.28), `0610010K14Rik` = c(34.97,
28.72, 32.6, 29.98, 29.93, 30.05, 38.07, 29.76, 28.63, 27.74
)), row.names = c(NA, 10L), class = "data.frame")
data
######
ui <- fluidPage(
mainPanel("666",
# width = 9,
tabPanel("123",
hr(),
typeaheadInput(
"select",
"Select",
choices = NULL,
minLength = 1,
value = "0610005C13Rik"
),
#####
actionButton(inputId = "plot_1", label = "123",width=80,class="btn btn-success"),
actionButton(inputId = "plot_2", label = "456",width=80,class="btn btn-light"),
actionButton(inputId = "plot_3", label = "789",width=80,class="btn btn-danger"),
hr(),
uiOutput("all"),
dataTableOutput('myTable1'),
dataTableOutput('myTable2'),
dataTableOutput('myTable3')
#####
)
))
server <- function(input, output, session) {
updateTypeaheadInput(session, "select", choices = colnames(data[,-1]))
observeEvent(list(input$plot_1,input$plot_2,input$plot_3), {
updateTabsetPanel(session, "666",
selected = "123"
)
})
#################
global <- reactiveValues(out = NULL
)
######
output$all <- renderUI({
global$out
})
observeEvent(input$plot_1,{
global$out <- plotOutput("myPlot_1")
myData_2(NULL)
myData_3(NULL)
})
observeEvent(input$plot_2, {
global$out <- plotOutput("myPlot_2")
myData_1(NULL)
myData_3(NULL)
})
observeEvent(input$plot_3, {
global$outtt <- plotOutput("myPlot_3")
myData_1(NULL)
myData_2(NULL)
})
#########################################
##
myPlot_1 = reactiveVal()
myPlot_2 = reactiveVal()
myPlot_3 = reactiveVal()
#
myData_1 = reactiveVal()
myData_2 = reactiveVal()
myData_3 = reactiveVal()
#################################### 1
observeEvent(input$plot_1, {
validate(need(sum(unique(colnames(data[,-1])) %in% input$select)>0, "The gene is not found."))
data_cor<-data[,-1]
tm <- corr.test(data_cor[,input$select,drop=FALSE],
y = data_cor, use = "pairwise", "spearman", adjust="none",
alpha=0.05, ci=F, minlength=5)
res <-setNames(as.data.frame(t(do.call(rbind, tm[c("r", "p")]))), c("Correlation", "P_value"))
res<-res[-which(rownames(res)== input$select),]
res<-data.frame(Gene=rownames(res),res)
res<-res[order(res$Correlation,decreasing = T),]
rownames(res)<-NULL
res<-na.omit(res)
res
##############
data_correlation=t(data[, -1])
data_subset=data_correlation[c(input$select, as.vector(head(res$Gene, 9))), ]
myPlot_1(
if(nrow(data_subset)>1){
pheatmap(log2(data_subset+1), show_colnames = F,fontsize_row =13,
# labels_row = as.expression(lapply(rownames(data_subset), function(a) bquote(italic(.(a))))),
cluster_rows = F, cluster_cols = F,
fontsize = 11,
cellwidth=4
)
}
)
myData_1(res)
})
######################################## 2
observeEvent(input$plot_2, {
validate(need(sum(unique(colnames(data[,-1])) %in% input$select)>0, "The gene is not found."))
data_cor<-data[,-1]
tm <- corr.test(data_cor[,input$select,drop=FALSE],
y = data_cor, use = "pairwise", "spearman", adjust="none",
alpha=0.05, ci=F, minlength=5)
res <-setNames(as.data.frame(t(do.call(rbind, tm[c("r", "p")]))), c("Correlation", "P_value"))
res<-res[-which(rownames(res)== input$select),]
res<-data.frame(Gene=rownames(res),res)
res<-res[order(res$Correlation,decreasing = T),]
rownames(res)<-NULL
res<-na.omit(res)
res
##############
data_correlation=t(data[, -1])
data_subset=data_correlation[c(input$select, as.vector(head(res$Gene, 9))), ]
myPlot_2(
if(nrow(data_subset)>1){
pheatmap(log2(data_subset+1), show_colnames = F,fontsize_row =13,
# labels_row = as.expression(lapply(rownames(data_subset), function(a) bquote(italic(.(a))))),
cluster_rows = F, cluster_cols = F,
fontsize = 11,
cellwidth=4
)
}
)
myData_2(res)
})
######################################## 3
observeEvent(input$plot_3, {
validate(need(sum(unique(colnames(data[,-1])) %in% input$select)>0, "The gene is not found."))
data_cor<-data[,-1]
tm <- corr.test(data_cor[,input$select,drop=FALSE],
y = data_cor, use = "pairwise", "spearman", adjust="none",
alpha=0.05, ci=F, minlength=5)
res <-setNames(as.data.frame(t(do.call(rbind, tm[c("r", "p")]))), c("Correlation", "P_value"))
res<-res[-which(rownames(res)== input$select),]
res<-data.frame(Gene=rownames(res),res)
res<-res[order(res$Correlation,decreasing = T),]
rownames(res)<-NULL
res<-na.omit(res)
res
##############
data_correlation=t(data[, -1])
data_subset=data_correlation[c(input$select, as.vector(head(res$Gene, 9))), ]
myPlot_3(
if(nrow(data_subset)>1){
pheatmap(log2(data_subset+1), show_colnames = F,fontsize_row =13,
# labels_row = as.expression(lapply(rownames(data_subset), function(a) bquote(italic(.(a))))),
cluster_rows = F, cluster_cols = F,
fontsize = 11,
cellwidth=4
)
}
)
myData_3(res)
})
################################### 1
output$myPlot_1 = renderPlot({
req(myPlot_1())
myPlot_1()
})
output$myTable1 = renderDataTable({
req(myData_1())
myData_1()
})
################################# 2
output$myPlot_2 = renderPlot({
req(myPlot_2())
myPlot_2()
})
output$myTable2 = renderDataTable({
req(myData_2())
myData_2()
})
################################# 3
output$myPlot_3 = renderPlot({
req(myPlot_3())
myPlot_3()
})
output$myTable3 = renderDataTable({
req(myData_3())
myData_3()
})
}
###################
# Create Shiny app ----
shinyApp(ui = ui, server = server)
who can help me
Solution 1:[1]
Similar to plot, you could to output the tables in a renderUI. Try this
ui <- fluidPage(
mainPanel("666",
# width = 9,
tabPanel("123",
hr(),
selectInput(
"select",
"Select",
choices = NULL#,
# minLength = 1,
# value = "0610005C13Rik"
),
#####
actionButton(inputId = "plot_1", label = "123",width=80,class="btn btn-success"),
actionButton(inputId = "plot_2", label = "456",width=80,class="btn btn-light"),
actionButton(inputId = "plot_3", label = "789",width=80,class="btn btn-danger"),
hr(),
uiOutput("all"),
uiOutput("mydata")
# dataTableOutput('myTable1'),
# dataTableOutput('myTable2'),
# dataTableOutput('myTable3')
#####
)
))
server <- function(input, output, session) {
updateSelectInput(session, "select", choices = colnames(data[,-1]))
observeEvent(list(input$plot_1,input$plot_2,input$plot_3), {
updateTabsetPanel(session, "666",
selected = "123"
)
})
#################
global <- reactiveValues(out = NULL, data = NULL
)
######
output$all <- renderUI({
global$out
})
output$mydata <- renderUI({
global$data
})
observeEvent(input$plot_1,{
global$out <- plotOutput("myPlot_1")
global$data <- DTOutput("myTable1")
# myData_2(NULL)
# myData_3(NULL)
})
observeEvent(input$plot_2, {
global$out <- plotOutput("myPlot_2")
global$data <- DTOutput("myTable2")
# myData_1(NULL)
# myData_3(NULL)
})
observeEvent(input$plot_3, {
global$out <- plotOutput("myPlot_3")
global$data <- DTOutput("myTable3")
# myData_1(NULL)
# myData_2(NULL)
})
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | YBS |