Question

我正尝试使用列名称为“ release_year”的数据框作为滑块输入，因此无论我选择哪种时间轴（假设1960年至1970年），我在散点图上只能看到该特定时间轴的数据。现在，我的滑块表现得很奇怪，除了移动了几点之外，什么也没做。我怎样才能解决这个问题？像这样 https://shiny.rstudio.com/gallery/movie-explorer.html 您看到年份发布滑块了吗？我想要那个确切的东西。

附加我的数据集的图像。

[df]（https://imgur.com/NZWuWtF）

 structure(list(id = c(135397L, 135397L, 76341L, 76341L, 262500L, 
140607L, 140607L, 140607L, 168259L, 168259L), budget = c(150000000L, 
150000000L, 150000000L, 150000000L, 110000000L, 200000000L, 200000000L, 
200000000L, 190000000L, 190000000L), revenue = c(1513528810, 
1513528810, 378436354, 378436354, 295238201, 2068178225, 2068178225, 
2068178225, 1506249360, 1506249360), title = structure(c(3L, 
3L, 4L, 4L, 2L, 5L, 5L, 5L, 1L, 1L), .Label = c("Furious 7", 
"Insurgent", "Jurassic World", "Mad Max: Fury Road", "Star Wars: The Force Awakens"
), class = "factor"), homepage = structure(c(2L, 2L, 3L, 3L, 
5L, 4L, 4L, 4L, 1L, 1L), .Label = c("http://www.furious7.com/", 
"http://www.jurassicworld.com/", "http://www.madmaxmovie.com/", 
"http://www.starwars.com/films/star-wars-episode-vii", "http://www.thedivergentseries.movie/#insurgent"
), class = "factor"), director = structure(c(1L, 1L, 2L, 2L, 
5L, 3L, 3L, 3L, 4L, 4L), .Label = c("Colin Trevorrow", "George Miller", 
"J.J. Abrams", "James Wan", "Robert Schwentke"), class = "factor"), 
    runtime = c(124L, 124L, 120L, 120L, 119L, 136L, 136L, 136L, 
    137L, 137L), vote_average = c(6.5, 6.5, 7.1, 7.1, 6.3, 7.5, 
    7.5, 7.5, 7.3, 7.3), release_year = c(2015L, 2015L, 2015L, 
    2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L), genre = structure(c(1L, 
    2L, 1L, 2L, 2L, 1L, 2L, 4L, 1L, 3L), .Label = c("Action", 
    "Adventure", "Crime", "Fantasy"), class = "factor"), breakeven = c(1363528810, 
    1363528810, 228436354, 228436354, 185238201, 1868178225, 
    1868178225, 1868178225, 1316249360, 1316249360), AerageVotesCat = structure(c(2L, 
    2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L), .Label = c("Excellent", 
    "Good"), class = "factor")), row.names = c(NA, 10L), class = "data.frame"

[需要控制显示数据的滑块]（https://imgur.com/vdvEJWN）

我几乎花了一个星期尝试所有事情。我似乎无法解决这个问题。我知道问题出在我的反应性括号中吗？但是作为新手，我不知道该传递什么。

UI:
library(gifski)
library(gganimate)
library(dplyr)
library(DT)
library(shinythemes)
library(scales)
library(shiny)
library(ggplot2)
library(plotly)



df <- read.csv("C:/Users/XXX/Downloads/movie1.csv")
n_total <- nrow(df)

ui <- fluidPage(theme = shinytheme("united"),
                titlePanel("Movie browser, 1960 - 2014", windowTitle = "Movies"),   

                # Sidebar layout with a input and output definitions
                sidebarLayout(
                  # Inputs
                  sidebarPanel(
                    wellPanel(

                      # Select variable for y-axis
                      selectInput(inputId = "y", 
                                  label = h4("Y-axis:"),
                                  choices =c("Budget" ="budget", "Revenue" = "revenue", "Runtime" = "runtime", "Vote average" = "vote_average", "Year released" = "release_year", "Profit" = "breakeven"), 
                                  selected = "revenue"),

                  sliderInput("SectorTime", h4("Select a time period:"), min = 1960, max = 2015,
                                value = c(1960,2015), step = 5),


                    textInput("Director", h4("Director name contains (e.g., Miyazaki)")),
                    numericInput(inputId = "n",
                                 label = h4("Sample size:"),
                                 value = 30,
                                 min = 1, max = n_total,
                                 step = 1),


                    radioButtons(inputId = "filetype",
                                 label = "Select filetype:",
                                 choices = c("csv", "tsv"),
                                 selected = "csv"),

                    # Select variables to download
                    checkboxGroupInput(inputId = "selected_var",
                                       label = "Select variables:",
                                       choices = names(df),
                                       selected = c("title"))
                  ),

                  # Outputs
                  mainPanel(
                    tabsetPanel(
                      tabPanel(h4("PLOT"), plotlyOutput("plot"),
                                            tabPanel(h4("DATA"), DT::dataTableOutput(outputId = "moviestable", width = 500)






                  )
                )
)

SERVER:

# Define server function required to create the scatterplot
server <- function(input, output) {

  dataset <- reactive({
    df[sample(nrow(df), input$SectorTime),]
  })


  # Create scatterplot object the plotOutput function is expecting
  output$plot <- renderPlotly({
    point <- format_format(big.mark = " ", decimal.mark = ",", scientific = FALSE)


    p <- ggplot(data = dataset(), aes_string(x = input$x, y = input$y, col = input$z)) +
      geom_point(alpha = input$alpha, size = 2, shape = 1)  +  theme_minimal() +
      ggtitle("Scatter plot between various variables") +scale_x_continuous(labels = point) + scale_y_continuous(labels = point)
    p +  theme(axis.text.x = element_text(angle = 30)) 

  })
   output$moviestable <- DT::renderDataTable({
    movies_sample <- df %>%
      sample_n(input$n) %>%
      select(title: AerageVotesCat)
    DT::datatable(data = movies_sample, 
                  options = list(pageLength = 30), 
                  rownames = FALSE)
  })

 }

# Create the Shiny app object
shinyApp(ui = ui, server = server)

这显然不是我的完整代码。我知道问题出在这里。非常感谢您的帮助。

Answer 1

您的问题是您滥用sample：第二个参数通常是样本大小，而不是要从中过滤的字段。有了您的数据，它就可以使用：

  dataset <- reactive({
    df[input$SectorTime[1] <= df$release_year &
        df$release_year <= input$SectorTime[2]  ,,drop=FALSE]
  })

如果您已经在工作流程中使用dplyr或data.table软件包，则两者都具有between功能，可以简化上述代码（尽管它们的速度并不快）。

更新

我已经修复了您的大部分代码，现在可以使用“导演过滤器”。在归约中，我删除了与该问题无关的内容（多余的包，不需要进行任何过滤的图），并提出了这个归约集。（我将留给您来回填已删除的组件。）

# library(gifski)
# library(gganimate)
library(dplyr)
library(DT)
#library(shinythemes)
# library(scales)
library(shiny)
# library(ggplot2)
# library(plotly)

n_total <- nrow(df)

ui <- fluidPage(
  titlePanel("Movie browser, 1960 - 2014", windowTitle = "Movies"),   
  # Sidebar layout with a input and output definitions
  sidebarLayout(
    # Inputs
    sidebarPanel(
      wellPanel(
        sliderInput("SectorTime", h4("Select a time period:"), min = 1960, max = 2015,
                    value = c(1960,2015), step = 5),
        textInput("Director", h4("Director name contains (e.g., Miyazaki)")),
        numericInput(inputId = "n",
                     label = h4("Sample size:"),
                     value = 30,
                     min = 1, max = n_total,
                     step = 1)
      )
    ),
    # Outputs
    mainPanel(
      tabsetPanel(
        tabPanel(h4("PLOT"), #plotlyOutput("plot"),
                 tabPanel(h4("DATA"), DT::dataTableOutput(outputId = "moviestable", width = 500))
                 )
      )
    )
  )
)

server <- function(input, output) {
  dataset <- reactive({
    req(input$SectorTime, !is.null(input$Director))
    df[input$SectorTime[1] <= df$release_year &
         df$release_year <= input$SectorTime[2] &
         grepl(input$Director, df$director, ignore.case = TRUE),, drop=FALSE]
  })
  output$moviestable <- DT::renderDataTable({
    req(input$n, dataset())
    movies_sample <- dataset() %>%
      sample_n(min(input$n, n())) %>%
      select(title: AerageVotesCat)
    DT::datatable(data = movies_sample, 
                  options = list(pageLength = 30), 
                  rownames = FALSE)
  })
}

您仍然没有做的某些事情：

所有表和图都必须使用过滤后的数据，而表是使用原始的df数据
采样不得超过框架的大小，您会很乐意允许用户将input$n设置为超出数据的有效大小
我鼓励您使用req(...)函数，以便在先决条件稳定之前不会触发块
（错别字：AverageVotesCat为AerageVotesCat）

此外，我假设您的“导演过滤器”类似于模式，而不是完全匹配的（正确使用grepl）。

<rant>

有关在SO上提问的评论，无需回答此特定问题：

对于以后的问题，重要的是您提供一个完整的工作示例：上面的代码在中间和结尾都缺少括号。（对于您的代码和dput输出来说都是如此。）帮助提出问题并在新的R会话中进行尝试，看看会发生什么，将很有帮助。这样一来，您将看到回答者在尝试帮助您时必须解决的无关问题。当我尝试别人的代码时，如果我在问题代码中发现错别字，我通常会立即将问题抛弃，因为“ 他们不知道问题到底是什么”或“ OP”不在乎我们的时间，要求我们做超出需要的事情”。后者似乎可以快速判断，但是我的时间对我来说很宝贵，所以我必须适当地分配它。
进一步，确实有帮助提供一个最小的工作示例。在这种情况下，问题与基本过滤有关，因此不需要绘图（ggplot2，plotly）和主题（shinythemes）。同样，gifski，gganimate和scales完全未使用。如果我的机器上没有安装“必需的软件包”，那么我通常会跳过一些问题，如果出于其他原因（除了我不想安装我不需要的Craft以外）。 减少代码 。如果由于代码滚动超出了代码窗格而无法立即看到代码，则您必须向自己说明为什么要为您的问题添加额外的代码。
“行不通” 对我来说，确实需要更多的时间和精力。但是没有指导（例如，错误消息，警告，“缺少数据”，某物），您正在请求端到端调试。通常这并不难，因为通常会弹出第一个警告/错误，但通常（对于某些人）警告/错误足够明显，可以在注释中解决它，必须加载所有代码/更改，修复代码（粘贴错误），然后尝试找出我认为是询问者含糊的“不起作用”的原因。

请记住，要获得答案，您有责任提出一个好的/简短/完整的问题，而不是我们解决不完整或不必要的冗长问题。

</rant>

我需要什么条件才能使我的地块起反应？

1 个答案: