[英]How to select rows of a matrix which has to meet mutiple conditions in R Shiny
目標是構建一個應用程序,該應用程序只能選擇和顯示滿足用戶通過諸如checkboxes
和sliderInput
類的Shiny元素選擇的特定條件的矩陣行。我們的data
受兩種(或更多)過濾方式的約束:
checkboxGroupInput
,用戶可以選擇一個或多個數字 sliders
。 每一列data
都有一個滑塊。 這允許用戶為每一列選擇數字范圍。 我堅持讓data
對用戶輸入的選擇做出反應。 任何建議表示贊賞!
這是我的代碼:
# Load libraries.
library(shiny)
library(datasets)
library(xtable)
library(R.utils)
shinyServer(
function(input, output) {
source('global.R', local=TRUE)
getDataName <- reactive({
out <- input$dataName
print(out)
return(out)
})
getData <- reactive({
cat("Getting data for, ", getDataName(), ".", sep = '')
if(getDataName() == ""){
print("ERROR: getDAtaName is empty! Check your code!")
out <- NULL
}
else {
dataSet <- t(combn(max(selectRange(getDataName())), numCols(getDataName())))
}
print(head(dataSet, n = 10))
return(dataSet)
})
selectedValues <- reactive({
print("Numbers selected via checkboxes:")
print(input$numSelector)
})
output$numSelector <- renderUI({
out <- checkboxGroupInput(
inputId = "numSelector",
label = "Select the numbers to be included in the rows",
choices = selectRange(input$dataName),
inline = TRUE
)
return(out)
})
output$sliders <- renderUI({
numSliders <- numCols(input$dataName)
lapply(1:numSliders, function(i) {
sliderInput(
inputId = paste0('column', i),
label = paste0('Select the range for column ', i),
min = min(selectRange(input$dataName)),
max = max(selectRange(input$dataName)),
value = c(min(selectRange(input$dataName)), max(selectRange(input$dataName))),
step =1)
})
})
output$selectedDataDisplay <- renderDataTable({
as.table(getData())}, options = list(lengthMenu = c(5, 30, 50), pageLength = 10))
}
)
library(shiny)
shinyUI(
pageWithSidebar(
headerPanel("Selection zone"),
# Select inputs
sidebarPanel(
selectInput(
inputId = "dataName",
label = "Select data",
choices = c("data1", "data2", "data3", "data4")
),
uiOutput(outputId = "numSelector"),
uiOutput(outputId = "sliders")
),
mainPanel(
tableOutput("selectedDataDisplay"))
)
)
selectRange <- function(x){
if(x == "data1"){choices = c(1:10)}
if(x == "data2"){choices = c(1:15)}
if(x == "data3"){choices = c(1:20)}
if(x == "data4"){choices = c(1:25)}
return(choices)
}
numCols <- function(x){
if(x == "data1"){maxNum = 10
numCol = 5}
if(x == "data2"){maxNum = 15
numCol = 5}
if(x == "data3"){maxNum = 20
numCol = 5}
if(x == "data4"){maxNum = 25
numCol = 6}
return(numCol)
}
您沒有提供實際的數據集,所以我模擬了一些,但我沒有確切的公式,但希望您可以擴展一下思路:
用戶界面
shinyUI(
pageWithSidebar(
headerPanel("Selection zone"),
# Select inputs
sidebarPanel(
# User enters name of dat.frame here.
selectInput(
inputId = "dataName",
label = "Select your data",
choices = c("data1", "data2", "data3", "data4")
),
uiOutput(outputId = "numSelector"),
uiOutput(outputId = "sliders")
),
mainPanel(
tabsetPanel(
tabPanel("Model Summary", dataTableOutput("selectedDataDisplay"), textOutput("vars"))
)
)
))
服務器
library(shiny)
library(data.table)
data1 <- matrix(round(runif(10000, min = 1, max = 20), 0), ncol = 10)
data2 <- matrix(round(runif(10000, min = 1, max = 20), 0), ncol = 10)
data3 <- matrix(round(runif(10000, min = 1, max = 20), 0), ncol = 10)
data4 <- matrix(round(runif(10000, min = 1, max = 20), 0), ncol = 10)
shinyServer(function(input, output) {
output$numSelector <- renderUI({
out <- checkboxGroupInput(
inputId = "numSelector",
label = "Select the numbers to be included in the rows",
choices = 1:20,
inline = TRUE
)
return(out)
})
output$sliders <- renderUI({
numSliders <- eval(parse(text = c("ncol(",input$dataName, ")")))
lapply(1:numSliders, function(i) {
sliderInput(
inputId = paste0('column', i),
label = paste0('Select the range for column ', i),
min = 1,
max = 20,
value = c(1, 20),
step = 1)
})
})
dataSet <- reactive({
if ( is.null(input$column1) ){
} else {
colName <- "Column"
eval(parse(text = c(paste0("set <- as.data.table(", input$dataName, ")"))))
setnames(set, colnames(set), paste0(colName, seq(ncol(set))))
# generate boolean values for each column's rows based upon individual ranges & the over all
validRows <- list()
for(k in seq(ncol(set))){
validRows[[k]] <- eval(parse(text = paste0("with(set, ", colName, k, " %in% input$column", k, "[1]:input$column", k, "[2] & ", colName, k, " %in% input$numSelector )")))
}
validRows <- do.call(cbind, validRows)
# if any of the column's conditions are satisfied, the row is accepted
validRows <- apply(validRows, 1, any)
# ouput accepted rows
set[ validRows ]
}
})
output$selectedDataDisplay <- renderDataTable(dataSet(), options = list(lengthMenu = c(5, 30, 50), pageLength = 10))
})
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.