Какие условия мне нужны, чтобы мой сюжет был реактивным? - PullRequest
1 голос
/ 12 мая 2019

Я пытаюсь использовать мой фрейм данных с именем столбца "release_year" в качестве входных данных ползунка, поэтому независимо от того, какую временную шкалу я выберу, скажем, с 1960 по 1970, я вижу данные только с этой конкретной временной шкалы на моем графике рассеяния. Прямо сейчас мой слайдер ведет себя довольно странно и на самом деле ничего не делает, кроме нескольких ходов. Как я могу это исправить? Что-то вроде этого https://shiny.rstudio.com/gallery/movie-explorer.html Вы видите слайдер года выпуска? Я хочу именно эту вещь.

  • Прикрепление изображений моего DataSet.
  • [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)

Это явно не мой полный код. Я знаю, что проблема где-то здесь. Буду признателен за вашу помощь.

1 Ответ

0 голосов
/ 12 мая 2019

Ваша проблема в том, что вы неправильно используете 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 data
  • не должна превышать размер кадра, вы бы с радостью позволили пользователю установить input$n выше эффективного размераданные
  • Я рекомендую вам использовать функцию req(...), чтобы блоки не срабатывали до того, как предпосылки стали стабильными
  • (опечатка: AverageVotesCat как AerageVotesCat)

Кроме того, я предположил, что ваш "фильтр директора" подобен шаблону и не является точным соответствием (поэтому используется grepl).


<rant>

Комментарий о том, как задавать вопросы по SO, для ответа на этот конкретный вопрос не требуется:

  1. Для будущих вопросов важно предоставить полный рабочий пример: выше, ваш кодпропущенные скобки, как в середине, так и в конце.(Как для вашего кода, так и для вывода dput.) Это поможет ответить на ваш вопрос и попробовать его в новом сеансе R и посмотреть, что произойдет.При этом вы увидите несвязанные проблемы, с которыми сталкиваются ответчики, пытаясь помочь вам.Когда я пробую чужой код, если я нахожу опечатки в коде вопроса, я часто сразу же отклоняю вопрос: либо « они не знают, в чем проблема на самом деле », либо « OP делаетне заботится о нашем времени, просит нас сделать больше, чем нужно".Последнее кажется быстрым, но мое время для меня ценно, поэтому я должен распределить его соответствующим образом.

  2. Далее, действительно помогает обеспечить минимальный рабочий пример.В этом случае проблема была связана с базовой фильтрацией, поэтому ни сюжеты (ggplot2, plotly), ни темы (shinythemes) не были необходимы.Точно так же gifski, gganimate и scales полностью не используются.Я часто пропускаю вопросы, когда вижу, что «требуемые пакеты» не установлены на моей машине, если по какой-либо другой причине, кроме как я не хочу устанавливать cruft, мне не нужно. Сократите код .Если код не сразу виден из-за того, что он прокручивается из области кода, вы должны объяснить себе, почему дополнительный код необходим для вашего вопроса.

  3. "делаетне работа " подсказывает мне, что это требует больше времени и внимания, конечно.Но без указания направления (например, сообщение об ошибке, предупреждение, «отсутствующие данные», что-то ) вы запрашиваете сквозную отладку.Часто это не сложно, так как первое всплывающее предупреждение / ошибка, как правило, очевидно, но часто предупреждение / ошибка достаточно очевидны (для некоторых), что их можно устранить в комментарии, а также загрузить весь код / ​​изменения, исправитькод (который был вставлен неправильно), а затем попробуйте выследить то, что, по моему мнению, является причиной смутного вопроса «не работает».

Помните, чтобы получить ответ,на вас лежит обязанность дать хороший / краткий / полный вопрос, а не на нас, чтобы обойти неполные или излишне длинные вопросы.

</rant>

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...