R Shiny中的下限和上限的多个滤波器
Posted
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了R Shiny中的下限和上限的多个滤波器相关的知识,希望对你有一定的参考价值。
所有这些代码都改编自Shiny - dynamic data filters using insertUI。
我目前正在使用R Shiny代码,该代码应该允许创建多个过滤器(与Shiny服务器允许的数量一样多)。
每个过滤器包括要过滤的变量的选择,上限,下限,以及是否仅通过采用上限和下限之间的值(即,lwr <x <upr)或相反的值来过滤值(即x <lwr∪x> upr)。我已将相关代码编译成与此问题特别相关的代码。
源代码(简化代码)如下:
library(shiny)
library(ggplot2)
# Column names of file.
logColumns <- names(read.csv("file.csv"))
ui <- fluidPage(
titlePanel("Testing Filters"),
sidebarLayout(
sidebarPanel(
# Data type to display as Y value in graph.
selectInput("display", label = "Data Type", choice = logColumns),
# Button to activate addFilter actions.
fluidRow(
column(6, actionButton('addFilter', "Add Filter")),
offset=6
),
tags$hr(),
# Area to generate new filters.
tags$div(id='filters'),
width = 4
),
mainPanel(
# Displays plot.
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
# File to use.
usefile <- reactive({
# Placeholder code, does basic file reading for now.
# Basic (unedited) file format is time (in milliseconds) in first column
# followed by other columns with different types of data, e.g., voltage.
usefile <- read.csv("file.csv", header=TRUE)
usefile$time <- usefile$time / 1000
usefile
})
# Column names of above file.
logNames <- reactive({
names(usefile())
})
# Turns aggregFilterObserver into a reactive list.
makeReactiveBinding("aggregFilterObserver")
aggregFilterObserver <- list()
observeEvent(input$addFilter, {
# Generates unique IDs for each filter.
add <- input$addFilter
filterId <- paste0('filter', add)
colFilter <- paste0('colFilter', add)
lwrBoundNum <- paste0('lowerBound', add)
uprBoundNum <- paste0('upperBound', add)
removeFilter <- paste0('removeFilter', add)
exclusivity <- paste0('exclusivity', add)
# Dictates which items are in each generated filter,
# and where each new UI element is generated.
insertUI(
selector = '#filters',
ui = tags$div(id = filterId,
actionButton(removeFilter, label = "Remove filter", style = "float: right;"),
selectInput(colFilter, label = paste("Filter", add), choices = logNames()),
numericInput(lwrBoundNum, label = "Lower Bound", value=0, width = 4000),
numericInput(uprBoundNum, label = "Upper Bound", value=0, width = 4000),
checkboxInput(exclusivity, label = "Within Boundaries?", value=TRUE)
)
)
# Generates a filter and updates min/max values.
observeEvent(input[[colFilter]], {
# Selects a data type to filter by.
filteredCol <- usefile()[[input[[colFilter]]]]
# Updates min and max values for lower and upper bounds.
updateNumericInput(session, lwrBoundNum, min=min(filteredCol), max=max(filteredCol))
updateNumericInput(session, uprBoundNum, min=min(filteredCol), max=max(filteredCol))
# Stores data type to filter with in col, and nulls rows.
aggregFilterObserver[[filterId]]$col <<- input[[colFilter]]
aggregFilterObserver[[filterId]]$rows <<- NULL
})
# Creates boolean vector by which to filter data.
observeEvent(c(input[[lwrBoundNum]], input[[uprBoundNum]], input[[colFilter]], input[[exclusivity]]), {
# Takes only data between lower and upper bound (inclusive), or
if (input[[exclusivity]]){
rows <- usefile()[[input[[colFilter]]]] >= input[[lwrBoundNum]]
rows <- "&"(rows, usefile()[[input[[colFilter]]]] <= input[[uprBoundNum]])
}
# Takes only data NOT between lower and upper bounds (inclusive).
else{
rows <- usefile()[[input[[colFilter]]]] < input[[lwrBoundNum]]
rows <- "|"(rows, usefile()[[input[[colFilter]]]] > input[[uprBoundNum]])
}
aggregFilterObserver[[filterId]]$rows <<- rows
})
# Removes filter.
observeEvent(input[[removeFilter]], {
# Deletes UI object...
removeUI(selector = paste0('#', filterId))
# and nulls the respective vectors in aggregFilterObserver.
aggregFilterObserver[[filterId]] <<- NULL
})
})
# Filters data based on boolean vectors contained in aggregFitlerObserver
adjusted <- reactive({
toAdjust <- rep(TRUE,nrow(usefile()))
lapply(aggregFilterObserver, function(filter){
toAdjust <- "&"(toAdjust, filter$rows)
})
subset(usefile(), toAdjust)
})
# Creates plot based on filtered data and selected data type
output$distPlot <- renderPlot({
xData <- adjusted()$time
yData <- adjusted()[[input$display]]
curData <- data.frame(xData, yData)
plot <- ggplot(data=curData, aes(x=xData, y=yData)) + geom_point() + labs(x = "Time (seconds)", y = input$display)
plot
})
}
# Run the application
shinyApp(ui = ui, server = server)
我的问题是通过布尔向量进行子集化不起作用 - 即,过滤器根本没有任何效果。
另外,我不太清楚应该如何应用上限和下限的措辞和变量名称(即“内部边界?”按钮和exclusivity
变量)。如果可以使用更好(尽管仍然简洁)的措辞,我也会对此有所帮助。
任何输入都表示赞赏。
编辑:用我当前的答案修复我的代码后,我意识到[修复] adjusted()
所拥有的代码并不完全是我想要的,而且我误解了lapply
实际上做了什么。我一直在尝试将多个逻辑向量编译成一个,这是通过执行以下操作实现的:
adjusted <- reactive({
toAdjust <- rep(TRUE,nrow(usefile()))
for (filter in aggregFilterObserver){
toAdjust <- "&"(toAdjust, filter$rows)
}
if (length(toAdjust) == 0){
usefile()
} else {
subset(usefile(), toAdjust)
}
})
感谢您的帮助!
答案
问题来自于您从未存储过滤结果。定义adjusted
时,永远不会存储lapply
的结果。
# Filters data based on boolean vectors contained in aggregFitlerObserver
adjusted <- reactive({
toAdjust <- rep(TRUE,nrow(usefile()))
tmp <- lapply(aggregFilterObserver, function(filter){
toAdjust <- "&"(toAdjust, filter$rows)
})
if (length(tmp$filter1) == 0) {
return(usefile())
} else {
subset(usefile(), tmp$filter1)
}
})
条件length(tmp$filter1) == 0
用于防止在没有过滤器时过滤所有行。
以上是关于R Shiny中的下限和上限的多个滤波器的主要内容,如果未能解决你的问题,请参考以下文章