将数据表的结果从一个选项卡显示到另一个选项卡,并将其分配给 Shiny 中的数据集列表
Display the results of a datatable from one tab into another and assign it to a list of datasets in Shiny
我有一个闪亮的应用程序,它将 ID
作为用户的输入,returns 数据帧的结果作为“ 中的数据table显示数据”选项卡。
我正在尝试将“显示数据”选项卡中的 table 结果分配给“数据集”选项卡中的列表。
app.R
library(shiny)
library(shinyWidgets)
library(dplyr)
library(tidyverse)
library(shinyjs)
library(magrittr)
library(purrr)
ID <- c("A","A","A","A","A","A","B","B","B","B","B","B")
Day <- c("Mon","Mon","Mon","Fri","Fri","Fri","Tue","Tue","Tue","Wed","Wed","Wed")
minute <- c(49,32,15,38,18,16,06,16,26,31,33,38)
second <- c(12,22,08,16,21,42,41,48,32,21,26,18)
hour0 <- c(0,0,0,60,0,0,0,0,0,0,0,0)
hour1 <- c(0,100,0,0,0,0,68,0,0,0,0,0)
hour2 <- c(0,0,0,0,0,0,0,92,0,0,0,72)
hour3 <- c(0,0,92,0,62,0,0,0,81,0,0,0)
hour4 <- c(110,0,0,0,0,0,0,0,0,93,0,0)
hour5 <- c(0,0,0,0,0,112,0,0,0,0,0,0)
hour6 <- c(0,0,0,0,0,0,0,0,0,0,105,0)
df_data <- data.frame(ID,Day,minute,second,hour0,hour1,hour2,hour3,hour4,hour5,hour6,
stringsAsFactors=FALSE)
ui <- fluidPage(
titlePanel("Dataset Tool"),
sidebarLayout(
sidebarPanel(width = 3,
conditionalPanel(
condition = "input.tabs=='Show data'",
textInput("id", "Enter ID:", "",
placeholder = "Eg: A"),
actionButton("submit", "Go")
),
conditionalPanel(
condition = "input.tabs=='Datasets'",
uiOutput("ui_datasets")
)
),
mainPanel(
tabsetPanel(id = "tabs",
tabPanel("Show data",
DT::dataTableOutput("dataTable")
),
tabPanel("Datasets",
DT::dataTableOutput("dataviewer")
)
)
)
)
)
server = function(input, output,session) {
r_state <- list()
r_info <- reactiveValues()
datasetlist <- c()
df <- list()
myData <- eventReactive(input$submit,{
data <- df_data %>%
modify_if(is.character, as.factor)
data %<>%
filter(ID == input$id)
})
observeEvent(input$submit, {
updateTabsetPanel(session,
inputId = "tableTab",
selected = "Show Data"
)
})
# Show the data in a table
output$dataTable <- DT::renderDataTable(
{
dat <- myData()
search <- r_state$datatable_state$search$search
if (is.null(search)) search <- ""
fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
DT::datatable(
dat,
selection = "none",
rownames = FALSE,
filter = fbox,
fillContainer = FALSE,
escape = FALSE,
style = "bootstrap",
options = list(
stateSave = TRUE, ## maintains state
searchCols = lapply(r_state$datatable_search_columns, function(x) list(search = x)),
search = list(search = search, regex = TRUE),
order = {
if (is.null(r_state$datatable_state$order)) {
list()
} else {
r_state$datatable_state$order
}
},
columnDefs = list(
list(orderSequence = c("desc", "asc"), targets = "_all"),
list(className = "dt-center", targets = "_all")
),
autoWidth = TRUE,
processing = isTRUE(fbox == "none"),
pageLength = {
if (is.null(r_state$datatable_state$length)) 10 else r_state$datatable_state$length
},
lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
),
callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
)
}
)
# new_df <- myData()
new_df <- df_data[0,]
df_filt <- list("Dataset1" = new_df)
df_names <- c("Dataset1")
for (dn in df_names) {
df[[dn]] <- df_filt[[dn]]
datasetlist <- c(datasetlist, dn)
}
r_info[["datasetlist"]] <- datasetlist
output$ui_datasets <- renderUI({
tagList(
selectInput(
inputId = "dataset",
label = "Datasets:",
choices = r_info[["datasetlist"]],
multiple = FALSE
)
)
})
observeEvent(input$dataviewer_search_columns, {
r_state$dataviewer_search_columns <<- input$dataviewer_search_columns
})
observeEvent(input$dataviewer_state, {
r_state$dataviewer_state <<-
if (is.null(input$dataviewer_state)) list() else input$dataviewer_state
})
output$dataviewer <- DT::renderDataTable({
dat <- df[[(input$dataset)]]
search <- r_state$dataviewer_state$search$search
if (is.null(search)) search <- ""
fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
DT::datatable(
dat,
filter = fbox,
selection = "none",
rownames = FALSE,
fillContainer = FALSE,
escape = FALSE,
style = "bootstrap",
options = list(
stateSave = TRUE, ## maintains state
searchCols = lapply(r_state$dataviewer_search_columns,
function(x) list(search = x)),
search = list(search = search, regex = TRUE),
order = {
if (is.null(r_state$dataviewer_state$order)) {
list()
} else {
r_state$dataviewer_state$order
}
},
columnDefs = list(
list(orderSequence = c("desc", "asc"), targets = "_all"),
list(className = "dt-center", targets = "_all")
),
autoWidth = TRUE,
processing = isTRUE(fbox == "none"),
pageLength = {
if (is.null(r_state$dataviewer_state$length)) 10 else r_state$dataviewer_state$length
},
lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
),
callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
我目前正在分配一个空数据框以显示在“Datasets”选项卡中,如下所示
new_df <- df_data[0,]
但我想在“显示数据”中向此“数据集”选项卡显示数据table结果并将其分配给数据集列表下的“Dataset1”列表。
我尝试使用下面的行来捕获和分配数据table 结果是“显示数据”,但不太正确。
new_df <- myData()
如果能提供任何帮助,我将不胜感激。谢谢
也许,你正在寻找这个。
ui <- fluidPage(
titlePanel("Dataset Tool"),
sidebarLayout(
sidebarPanel(width = 3,
conditionalPanel(
condition = "input.tabs=='Show data'",
textInput("id", "Enter ID:", "",
placeholder = "Eg: A"),
actionButton("submit", "Go")
),
conditionalPanel(
condition = "input.tabs=='Datasets'",
uiOutput("ui_datasets")
)
),
mainPanel(
tabsetPanel(id = "tabs",
tabPanel("Show data",
DT::dataTableOutput("dataTable")
),
tabPanel("Datasets",
DT::dataTableOutput("dataviewer"), verbatimTextOutput("t1") #, DTOutput("tb1")
)
)
)
)
)
server = function(input, output,session) {
r_state <- list()
r_info <- reactiveValues()
df1 <- reactiveValues(data=NULL)
datasetlist <- c()
df <- list()
myData <- eventReactive(input$submit,{
data <- df_data %>%
modify_if(is.character, as.factor)
data %<>%
filter(ID == req(input$id))
df1$data <- data
data
})
observeEvent(input$submit, {
updateTabsetPanel(session,
inputId = "tableTab",
selected = "Show Data"
)
})
# Show the data in a table
output$dataTable <- DT::renderDataTable(
{
dat <- myData()
search <- r_state$datatable_state$search$search
if (is.null(search)) search <- ""
fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
DT::datatable(
dat,
selection = "none",
rownames = FALSE,
filter = fbox,
fillContainer = FALSE,
escape = FALSE,
style = "bootstrap",
options = list(
stateSave = TRUE, ## maintains state
searchCols = lapply(r_state$datatable_search_columns, function(x) list(search = x)),
search = list(search = search, regex = TRUE),
order = {
if (is.null(r_state$datatable_state$order)) {
list()
} else {
r_state$datatable_state$order
}
},
columnDefs = list(
list(orderSequence = c("desc", "asc"), targets = "_all"),
list(className = "dt-center", targets = "_all")
),
autoWidth = TRUE,
processing = isTRUE(fbox == "none"),
pageLength = {
if (is.null(r_state$datatable_state$length)) 10 else r_state$datatable_state$length
},
lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
),
callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
)
}
)
######
observeEvent(input$submit,{
# new_df <- myData()
# new_df <- df_data[0,]
# df_filt <- list("Dataset1" = new_df)
df_names <- c(paste0("Dataset",input$submit))
for (dn in df_names) {
df1[[dn]] <- myData() # df_filt[[dn]]
datasetlist <<- c(datasetlist, dn)
}
r_info[["datasetlist"]] <- datasetlist
output$t1 <- renderPrint({print(datasetlist)})
output$tb1 <- renderDT(df1[[dn]])
}) ##end of observeEvent
output$ui_datasets <- renderUI({
tagList(
selectInput(
inputId = "dataset",
label = "Datasets:",
choices = r_info[["datasetlist"]], # datasetlist, #
#selected = r_info[[paste0("Dataset",input$submit)]],
multiple = FALSE
)
)
})
observeEvent(input$dataviewer_search_columns, {
r_state$dataviewer_search_columns <<- input$dataviewer_search_columns
})
observeEvent(input$dataviewer_state, {
r_state$dataviewer_state <<-
if (is.null(input$dataviewer_state)) list() else input$dataviewer_state
})
output$dataviewer <- DT::renderDataTable({
dat <- df1[[(input$dataset)]]
#dat <- myData()
search <- r_state$dataviewer_state$search$search
if (is.null(search)) search <- ""
fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
DT::datatable(
dat,
filter = fbox,
selection = "none",
rownames = FALSE,
fillContainer = FALSE,
escape = FALSE,
style = "bootstrap",
options = list(
stateSave = TRUE, ## maintains state
searchCols = lapply(r_state$dataviewer_search_columns,
function(x) list(search = x)),
search = list(search = search, regex = TRUE),
order = {
if (is.null(r_state$dataviewer_state$order)) {
list()
} else {
r_state$dataviewer_state$order
}
},
columnDefs = list(
list(orderSequence = c("desc", "asc"), targets = "_all"),
list(className = "dt-center", targets = "_all")
),
autoWidth = TRUE,
processing = isTRUE(fbox == "none"),
pageLength = {
if (is.null(r_state$dataviewer_state$length)) 10 else r_state$dataviewer_state$length
},
lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
),
callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
我有一个闪亮的应用程序,它将 ID
作为用户的输入,returns 数据帧的结果作为“ 中的数据table显示数据”选项卡。
我正在尝试将“显示数据”选项卡中的 table 结果分配给“数据集”选项卡中的列表。
app.R
library(shiny)
library(shinyWidgets)
library(dplyr)
library(tidyverse)
library(shinyjs)
library(magrittr)
library(purrr)
ID <- c("A","A","A","A","A","A","B","B","B","B","B","B")
Day <- c("Mon","Mon","Mon","Fri","Fri","Fri","Tue","Tue","Tue","Wed","Wed","Wed")
minute <- c(49,32,15,38,18,16,06,16,26,31,33,38)
second <- c(12,22,08,16,21,42,41,48,32,21,26,18)
hour0 <- c(0,0,0,60,0,0,0,0,0,0,0,0)
hour1 <- c(0,100,0,0,0,0,68,0,0,0,0,0)
hour2 <- c(0,0,0,0,0,0,0,92,0,0,0,72)
hour3 <- c(0,0,92,0,62,0,0,0,81,0,0,0)
hour4 <- c(110,0,0,0,0,0,0,0,0,93,0,0)
hour5 <- c(0,0,0,0,0,112,0,0,0,0,0,0)
hour6 <- c(0,0,0,0,0,0,0,0,0,0,105,0)
df_data <- data.frame(ID,Day,minute,second,hour0,hour1,hour2,hour3,hour4,hour5,hour6,
stringsAsFactors=FALSE)
ui <- fluidPage(
titlePanel("Dataset Tool"),
sidebarLayout(
sidebarPanel(width = 3,
conditionalPanel(
condition = "input.tabs=='Show data'",
textInput("id", "Enter ID:", "",
placeholder = "Eg: A"),
actionButton("submit", "Go")
),
conditionalPanel(
condition = "input.tabs=='Datasets'",
uiOutput("ui_datasets")
)
),
mainPanel(
tabsetPanel(id = "tabs",
tabPanel("Show data",
DT::dataTableOutput("dataTable")
),
tabPanel("Datasets",
DT::dataTableOutput("dataviewer")
)
)
)
)
)
server = function(input, output,session) {
r_state <- list()
r_info <- reactiveValues()
datasetlist <- c()
df <- list()
myData <- eventReactive(input$submit,{
data <- df_data %>%
modify_if(is.character, as.factor)
data %<>%
filter(ID == input$id)
})
observeEvent(input$submit, {
updateTabsetPanel(session,
inputId = "tableTab",
selected = "Show Data"
)
})
# Show the data in a table
output$dataTable <- DT::renderDataTable(
{
dat <- myData()
search <- r_state$datatable_state$search$search
if (is.null(search)) search <- ""
fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
DT::datatable(
dat,
selection = "none",
rownames = FALSE,
filter = fbox,
fillContainer = FALSE,
escape = FALSE,
style = "bootstrap",
options = list(
stateSave = TRUE, ## maintains state
searchCols = lapply(r_state$datatable_search_columns, function(x) list(search = x)),
search = list(search = search, regex = TRUE),
order = {
if (is.null(r_state$datatable_state$order)) {
list()
} else {
r_state$datatable_state$order
}
},
columnDefs = list(
list(orderSequence = c("desc", "asc"), targets = "_all"),
list(className = "dt-center", targets = "_all")
),
autoWidth = TRUE,
processing = isTRUE(fbox == "none"),
pageLength = {
if (is.null(r_state$datatable_state$length)) 10 else r_state$datatable_state$length
},
lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
),
callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
)
}
)
# new_df <- myData()
new_df <- df_data[0,]
df_filt <- list("Dataset1" = new_df)
df_names <- c("Dataset1")
for (dn in df_names) {
df[[dn]] <- df_filt[[dn]]
datasetlist <- c(datasetlist, dn)
}
r_info[["datasetlist"]] <- datasetlist
output$ui_datasets <- renderUI({
tagList(
selectInput(
inputId = "dataset",
label = "Datasets:",
choices = r_info[["datasetlist"]],
multiple = FALSE
)
)
})
observeEvent(input$dataviewer_search_columns, {
r_state$dataviewer_search_columns <<- input$dataviewer_search_columns
})
observeEvent(input$dataviewer_state, {
r_state$dataviewer_state <<-
if (is.null(input$dataviewer_state)) list() else input$dataviewer_state
})
output$dataviewer <- DT::renderDataTable({
dat <- df[[(input$dataset)]]
search <- r_state$dataviewer_state$search$search
if (is.null(search)) search <- ""
fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
DT::datatable(
dat,
filter = fbox,
selection = "none",
rownames = FALSE,
fillContainer = FALSE,
escape = FALSE,
style = "bootstrap",
options = list(
stateSave = TRUE, ## maintains state
searchCols = lapply(r_state$dataviewer_search_columns,
function(x) list(search = x)),
search = list(search = search, regex = TRUE),
order = {
if (is.null(r_state$dataviewer_state$order)) {
list()
} else {
r_state$dataviewer_state$order
}
},
columnDefs = list(
list(orderSequence = c("desc", "asc"), targets = "_all"),
list(className = "dt-center", targets = "_all")
),
autoWidth = TRUE,
processing = isTRUE(fbox == "none"),
pageLength = {
if (is.null(r_state$dataviewer_state$length)) 10 else r_state$dataviewer_state$length
},
lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
),
callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
我目前正在分配一个空数据框以显示在“Datasets”选项卡中,如下所示
new_df <- df_data[0,]
但我想在“显示数据”中向此“数据集”选项卡显示数据table结果并将其分配给数据集列表下的“Dataset1”列表。
我尝试使用下面的行来捕获和分配数据table 结果是“显示数据”,但不太正确。
new_df <- myData()
如果能提供任何帮助,我将不胜感激。谢谢
也许,你正在寻找这个。
ui <- fluidPage(
titlePanel("Dataset Tool"),
sidebarLayout(
sidebarPanel(width = 3,
conditionalPanel(
condition = "input.tabs=='Show data'",
textInput("id", "Enter ID:", "",
placeholder = "Eg: A"),
actionButton("submit", "Go")
),
conditionalPanel(
condition = "input.tabs=='Datasets'",
uiOutput("ui_datasets")
)
),
mainPanel(
tabsetPanel(id = "tabs",
tabPanel("Show data",
DT::dataTableOutput("dataTable")
),
tabPanel("Datasets",
DT::dataTableOutput("dataviewer"), verbatimTextOutput("t1") #, DTOutput("tb1")
)
)
)
)
)
server = function(input, output,session) {
r_state <- list()
r_info <- reactiveValues()
df1 <- reactiveValues(data=NULL)
datasetlist <- c()
df <- list()
myData <- eventReactive(input$submit,{
data <- df_data %>%
modify_if(is.character, as.factor)
data %<>%
filter(ID == req(input$id))
df1$data <- data
data
})
observeEvent(input$submit, {
updateTabsetPanel(session,
inputId = "tableTab",
selected = "Show Data"
)
})
# Show the data in a table
output$dataTable <- DT::renderDataTable(
{
dat <- myData()
search <- r_state$datatable_state$search$search
if (is.null(search)) search <- ""
fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
DT::datatable(
dat,
selection = "none",
rownames = FALSE,
filter = fbox,
fillContainer = FALSE,
escape = FALSE,
style = "bootstrap",
options = list(
stateSave = TRUE, ## maintains state
searchCols = lapply(r_state$datatable_search_columns, function(x) list(search = x)),
search = list(search = search, regex = TRUE),
order = {
if (is.null(r_state$datatable_state$order)) {
list()
} else {
r_state$datatable_state$order
}
},
columnDefs = list(
list(orderSequence = c("desc", "asc"), targets = "_all"),
list(className = "dt-center", targets = "_all")
),
autoWidth = TRUE,
processing = isTRUE(fbox == "none"),
pageLength = {
if (is.null(r_state$datatable_state$length)) 10 else r_state$datatable_state$length
},
lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
),
callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
)
}
)
######
observeEvent(input$submit,{
# new_df <- myData()
# new_df <- df_data[0,]
# df_filt <- list("Dataset1" = new_df)
df_names <- c(paste0("Dataset",input$submit))
for (dn in df_names) {
df1[[dn]] <- myData() # df_filt[[dn]]
datasetlist <<- c(datasetlist, dn)
}
r_info[["datasetlist"]] <- datasetlist
output$t1 <- renderPrint({print(datasetlist)})
output$tb1 <- renderDT(df1[[dn]])
}) ##end of observeEvent
output$ui_datasets <- renderUI({
tagList(
selectInput(
inputId = "dataset",
label = "Datasets:",
choices = r_info[["datasetlist"]], # datasetlist, #
#selected = r_info[[paste0("Dataset",input$submit)]],
multiple = FALSE
)
)
})
observeEvent(input$dataviewer_search_columns, {
r_state$dataviewer_search_columns <<- input$dataviewer_search_columns
})
observeEvent(input$dataviewer_state, {
r_state$dataviewer_state <<-
if (is.null(input$dataviewer_state)) list() else input$dataviewer_state
})
output$dataviewer <- DT::renderDataTable({
dat <- df1[[(input$dataset)]]
#dat <- myData()
search <- r_state$dataviewer_state$search$search
if (is.null(search)) search <- ""
fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
DT::datatable(
dat,
filter = fbox,
selection = "none",
rownames = FALSE,
fillContainer = FALSE,
escape = FALSE,
style = "bootstrap",
options = list(
stateSave = TRUE, ## maintains state
searchCols = lapply(r_state$dataviewer_search_columns,
function(x) list(search = x)),
search = list(search = search, regex = TRUE),
order = {
if (is.null(r_state$dataviewer_state$order)) {
list()
} else {
r_state$dataviewer_state$order
}
},
columnDefs = list(
list(orderSequence = c("desc", "asc"), targets = "_all"),
list(className = "dt-center", targets = "_all")
),
autoWidth = TRUE,
processing = isTRUE(fbox == "none"),
pageLength = {
if (is.null(r_state$dataviewer_state$length)) 10 else r_state$dataviewer_state$length
},
lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
),
callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
)
})
}
# Run the application
shinyApp(ui = ui, server = server)