我正在尝试构建一个函数，它将选择从文件中输入的数据变量，并显示要通过下拉列表选择的数据变量，并显示当前选择的变量。
在这里，我可以添加文件并在过滤器选项卡的下拉列表中显示数据变量，但是我无法在服务器中捕获当前选择的变量以应用过滤器。
下面是代码
服务器.R
library(shiny)
library(shinyBS)
library(shinyjs)
server <- function(input, output, session) {
myValue <- reactiveValues()
# Import Data File
observeEvent(input$data_import,{
if(is.null(input$datafile))
myValue$data<-NULL
inFile<-input$datafile
myValue$data <- rio::import(inFile$datapath)
})
# Render Input DataTable
output$show_data <- DT::renderDataTable(
myValue$data, server = FALSE, escape = FALSE, selection = 'none'
)
#Functions
shinyInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))
}
inputs
}
SingleshinyInput <- function(FUN, i, id, ...) {
inputs <- character(i)
inputs <- as.character(FUN(paste0(id, i), ...))
inputs
}
#Display Dynamic Input Filter table
observe({
if(is.null(myValue$data))
return()
Names <- colnames(myValue$data)
myValue$Filter = data.frame(
Logic = c(NA,shinyInput(selectInput, 4, 'logic_', label = "", choices = c("And","Or"))),
Variable = shinyInput(selectInput, 5, 'var_', label = "", choices = Names ),
Filter = shinyInput(actionButton, 5, 'go_button_', label = "Filter", onclick = 'Shiny.onInputChange(\"select_button\", this.id)' ),
Remove = shinyInput(actionButton, 5, 'remove_button_', "", icon = icon("close"), onclick = 'Shiny.onInputChange(\"select_remove_button\", this.id)' ),
stringsAsFactors = FALSE,
row.names = 1:5
)
}
)
#Add new Filter Row
observeEvent(input$addnewRow,{
if(is.null(myValue$Filter))
return()
i <- as.character(max(as.numeric(row.names(myValue$Filter)))+1)
newRow <- data.frame(Logic = SingleshinyInput(selectInput, i, 'logic_', label = "", choices = c("And","Or")),
Variable = SingleshinyInput(selectInput, i, 'var_', label = "", choices = Names ),
Filter = SingleshinyInput(actionButton, i, 'go_button_', label = "Filter", onclick = 'Shiny.onInputChange(\"select_button\", this.id)' ),
Remove = SingleshinyInput(actionButton, i, 'remove_button_', "", icon = icon("close"), onclick = 'Shiny.onInputChange(\"select_remove_button\", this.id)' ),
stringsAsFactors = FALSE,
row.names = i)
myValue$Filter <- rbind(myValue$Filter,newRow)
})
# Render Filter Data Table
output$data <- DT::renderDataTable(
myValue$Filter, server = FALSE, escape = FALSE, selection = 'none'
)
# Remove filter Row
observeEvent(input$select_remove_button,{
if(is.null(myValue$Filter))
return()
rowToRemove<-unlist(strsplit(input$select_remove_button,"_"))
rowToRemove<-rowToRemove[length(rowToRemove)]
rowToRemove<-which(row.names(myValue$Filter)==rowToRemove)
myValue$Filter<-myValue$Filter[-rowToRemove,]
if(!is.na(myValue$Filter$Logic[1]))
myValue$Filter$Logic[1]<-NA
})
# Display bsModal for filter
observeEvent(input$select_button, {
toggleModal(session,"CustomDataFilter",toggle="open")
})
# Select the variable value selected in the select Input
output$FilterDataSettings <- renderUI({
selected<-unlist(strsplit(input$select_button,"_"))
selected<-as.numeric(selected[length(selected)])
Names <- colnames(myValue$data)
selected_var<-Names[selected]
print(selected_var)
selected<-as.numeric(selected)
print(input[[paste0("var_",selected)]])
return(NULL)
})
output$result <- renderText({
selected<-unlist(strsplit(input$select_button,"_"))
selected<-as.numeric(selected[length(selected)])
paste("You chose", input[[paste0("var_",selected)]])
print(input[[paste0("var_",selected)]])
})
# Show Table Dimensions
output$showDataDimensions.FilterData <- renderUI({
if(is.null(myValue$data)){
return(paste("The data is not selected "))
}
Dim<-dim(myValue$data)
paste("Dimensions", Dim[1], "X" , Dim[2])
})
}
用户界面
shinyUI(fluidPage(
tags$button(
id = "reset_button",
class="btn action-button",
icon("close")
),
bsModal("CustomDataFilter","Settings","go_CustomDataFilter_Settings",size="small",
# radioButtons("Less_Than_Greater_Than","Less Than or Greater Than",choices=c("Less Than","Greater Than"),selected="Less Than",inline = TRUE),
uiOutput("FilterDataSettings"),
textOutput("result")
),
tabsetPanel(
tabPanel("Data",
titlePanel("Custom Data Filter"),
sidebarLayout(
sidebarPanel(
fileInput('datafile', h4('Import File'),
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
actionButton("data_import","Import")
),
mainPanel(
DT::dataTableOutput("show_data")
)
)
),
tabPanel("Filter",
sidebarLayout(
sidebarPanel(
uiOutput("showDataDimensions.FilterData")
),
mainPanel(
DT::dataTableOutput("data"),
actionButton("addnewRow"," Add New Filter "),
actionButton("applyFilter"," Apply Filter to Data ")
)
)
)
)
)
)
感谢您浏览代码并感谢您的回复。