1

ユーザー入力をラジオ ボタンとしてデータ フレームをフィルター処理しようとしています。残念ながら、機能するフィルターは 1 つのタイプ (私の例では「年次」バージョン) だけですが、「月次」および「四半期」オプションでは何も返されません。これが私のサンプルデータセットとコードです。

    # sample data
mydf <- data.frame("Data"=rnorm(12), 
                   "Months"=c("Jan", "Nov", "Dec", "Feb", 
                              "Mar", "Apr", "May", "Jun", 
                              "Jul", "Aug", "Sep", "Oct"))
library(shiny)
library(dbplyr)
ui <- fluidPage(
        # Input() function
        radioButtons(inputId = "myDateInterval", label = "Select Date Interval",
                     choiceNames = list("Monthly","Quarterly","Annual"),
                     choiceValues = list(unique(as.character(mydf$Month)),
                                         unique(as.character(mydf$Month))
                                      [seq(1,length(unique(mydf$Month)),3)],
                                         unique(as.character(mydf$Month)[1]))),

        # Output() functions
        tableOutput("results"))
# set up server object
server <- function(input, output) {
        output$results <-  renderTable({
                mydf %>% filter(Months %in% input$myDateInterval)
        })
}
shinyApp(ui = ui, server = server)
4

2 に答える 2

0

これはあなたのために働くでしょうか：

ui <- fluidPage(
  # Input() function
  radioButtons(inputId = "myDateInterval", label = "Select Date Interval",
               choiceNames = list("Monthly","Quarterly","Annual"), choiceValues = list("Monthly","Quarterly","Annual")),

  # Output() functions
  tableOutput("results"))
# set up server object
server <- function(input, output) {
  output$results <-  renderTable({

    if(input$myDateInterval == "Monthly") {

   mydf2 <- mydf %>% filter(Months %in% (unique(as.character(mydf$Month))))

    }

    if(input$myDateInterval == "Quarterly") {

      mydf2 <- mydf %>% filter(Months %in% (unique(as.character(mydf$Month)))[seq(1,length(unique(mydf$Month)),3)])

    }

    if(input$myDateInterval == "Annual") {

      mydf2 <- mydf %>% filter(Months %in% (unique(as.character(mydf$Month)[1])))

    }

    mydf2
  })
}
shinyApp(ui = ui, server = server)
于 2018-02-20T17:58:15.380 に答える