1

我是 Shiny 和反应性的新手，正在做我的功课。我不知道如何解决以下问题。我想要一个默认情况下显示所有性别的图，其中 x 轴是高度，y 轴是家庭世界（就像现在一样）。然后我想有两个多选输入，我可以从中为我的情节选择条件。例如，当我选择白头发（或其他几种类型）时，我应该只看到我为头发申请的观察结果（与物种类似）。但是当我选择 brown Hair 和 human Species 时，它应该指向我同时满足这两个条件的观察结果。默认情况下，当 x 轴为高度且 y 轴为 homeworld 时，该图应显示所有观察结果。这是我到目前为止所做的。

library(shiny)
library(dplyr)
library(DT)
library(plotly)

?starwars



# Step 1 - prepare row data

# a) add missing info

starwars_data = starwars %>%
  mutate(
    ID = rownames(starwars),
    height = case_when(
      name == 'Finn' ~ as.integer(178),
      name == 'Rey' ~ as.integer(170),
      name == 'Poe Dameron' ~ as.integer(172),
      name == 'BB8' ~ as.integer(67),
      name == 'Captain Phasma' ~ as.integer(200),
      TRUE ~ height
    ),
    mass = case_when(
      name == 'Finn' ~ 73,
      name == 'Rey' ~ 54,
      name == 'Poe Dameron' ~ 80,
      name == 'BB8' ~ 18,
      name == 'Captain Phasma' ~ 76,
      TRUE ~ mass
    ),
    film_counter = lengths(films),
    vehicle_counter = lengths(vehicles),
    starship_counter = lengths(starships)
  ) %>% 
  mutate_all(funs(replace(., is.na(.), 'not applicable')))


# 2) Prepare layout

hair = starwars_data %>% 
  select(hair_color) %>% 
  distinct()


spec = starwars_data %>% 
  select(species) %>% 
  distinct()


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput('hair', 'Hair', hair, multiple = TRUE),
      selectInput('spec', 'Species', spec, multiple = TRUE)
    ),
    mainPanel(
      plotlyOutput('plot'),
      tableOutput('txt2')
      #dataTableOutput('table'))
    )
  )
)


srv <- function(input, output){


  starwars_data_hair = reactive({
    input$hair
    starwars_data %>%
      filter(hair_color %in% input$hair)
  })

  starwars_data_species = reactive({
    input$spec
    starwars_data %>%
      filter(species %in% input$spec)
  })

  output$plot <- renderPlotly({
    plot_ly((starwars_data),
            source = 'scatter') %>%
      add_markers(
        x = ~height,
        y = ~homeworld,
        color = ~factor(gender),
        key = ~ID
      ) %>%
      layout(
        xaxis = list(title = 'Height', rangemode = "tozero"),
        yaxis = list(title = 'Homeland', rangemode = "tozero"),
        dragmode = "select"
      )
  })

}
  shinyApp(ui, srv)

谢谢你的任何提示。

4

2 回答 2

0

几件事：

  • 您正在使用相同的输入starwars_data数据框进行绘图，因此尽管进行了选择，绘图仍保持不变

  • 您不需要两个不同的反应函数进行过滤

  • 访问反应元素就像访问函数，因此我用于starwars_data_filtered()绘图

检查更新的代码：

library(shiny)
library(dplyr)
library(DT)
library(plotly)

?starwars



# Step 1 - prepare row data

# a) add missing info

starwars_data = starwars %>%
  mutate(
    ID = rownames(starwars),
    height = case_when(
      name == 'Finn' ~ as.integer(178),
      name == 'Rey' ~ as.integer(170),
      name == 'Poe Dameron' ~ as.integer(172),
      name == 'BB8' ~ as.integer(67),
      name == 'Captain Phasma' ~ as.integer(200),
      TRUE ~ height
    ),
    mass = case_when(
      name == 'Finn' ~ 73,
      name == 'Rey' ~ 54,
      name == 'Poe Dameron' ~ 80,
      name == 'BB8' ~ 18,
      name == 'Captain Phasma' ~ 76,
      TRUE ~ mass
    ),
    film_counter = lengths(films),
    vehicle_counter = lengths(vehicles),
    starship_counter = lengths(starships)
  ) %>% 
  mutate_all(funs(replace(., is.na(.), 'not applicable')))


# 2) Prepare layout

hair = starwars_data %>% 
  select(hair_color) %>% 
  distinct()


spec = starwars_data %>% 
  select(species) %>% 
  distinct()


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput('hair', 'Hair', hair, multiple = TRUE),
      selectInput('spec', 'Species', spec, multiple = TRUE)
    ),
    mainPanel(
      plotlyOutput('plot'),
      tableOutput('txt2')
      #dataTableOutput('table'))
    )
  )
)


srv <- function(input, output){


  starwars_data_filtered = reactive({
    input$hair
    starwars_data %>%
      filter(hair_color %in% input$hair) %>% 
      filter(species %in% input$spec)
  })



  output$plot <- renderPlotly({
    plot_ly((starwars_data_filtered()),
            source = 'scatter') %>%
      add_markers(
        x = ~height,
        y = ~homeworld,
        color = ~factor(gender),
        key = ~ID
      ) %>%
      layout(
        xaxis = list(title = 'Height', rangemode = "tozero"),
        yaxis = list(title = 'Homeland', rangemode = "tozero"),
        dragmode = "select"
      )
  })

}
shinyApp(ui, srv)
于 2017-11-21T12:16:52.900 回答
0

我想我到了那里，这就是我所做的：

library(shiny)
library(dplyr)
library(DT)
library(plotly)

?starwars



# Step 1 - prepare row data

# a) replace NA values in columns

starwars_data_as_table <- as_tibble(starwars)
starwars_data_as_table$gender[is.na(starwars_data_as_table$gender)] <- 'not applicable'
starwars_data_as_table$homeworld[is.na(starwars_data_as_table$homeworld)] <- 'unknown'
starwars_data_as_table$species[is.na(starwars_data_as_table$species)] <- 'unknown'
starwars_data_as_table$hair_color[is.na(starwars_data_as_table$hair_color)] <- 'not applicable'

# b) add missing info

starwars_data = starwars_data_as_table %>%
  mutate(
    ID = rownames(starwars),
    height = case_when(
      name == 'Finn' ~ as.integer(178),
      name == 'Rey' ~ as.integer(170),
      name == 'Poe Dameron' ~ as.integer(172),
      name == 'BB8' ~ as.integer(67),
      name == 'Captain Phasma' ~ as.integer(200),
      TRUE ~ height
    ),
    mass = case_when(
      name == 'Finn' ~ 73,
      name == 'Rey' ~ 54,
      name == 'Poe Dameron' ~ 80,
      name == 'BB8' ~ 18,
      name == 'Captain Phasma' ~ 76,
      TRUE ~ mass
    ),
    film_counter = lengths(films),
    vehicle_counter = lengths(vehicles),
    starship_counter = lengths(starships)
  )

typeof(starwars_data)


# 2) Prepare layout

hair = starwars_data %>%
  select(hair_color) %>%
  arrange(hair_color) %>% 
  distinct()


spec = starwars_data %>% 
  select(species) %>% 
  arrange(species) %>% 
  distinct()


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput('hair', 'Hair', hair, multiple = TRUE),
      selectInput('spec', 'Species', spec, multiple = TRUE)
    ),
    mainPanel(
      plotlyOutput('plot')
      # tableOutput('txt2')
      #dataTableOutput('table'))
    )
  )
)


srv <- function(input, output){

  d = starwars_data

  starwars_data_filtered <-  reactive({

    if(length(input$hair) > 0){
      d <-  d %>% 
        filter(hair_color %in% input$hair)
    }
    if (length(input$spec) > 0) {
      d <-  d %>% 
        filter(species %in% input$spec)
    } 
    if (length(input$spec) > 0 & length(input$hair) > 0) {
        d <-  d %>% 
          filter(hair_color %in% input$hair) %>% 
            filter(species %in% input$spec)
    }
    d
  })


  output$plot <- renderPlotly({
      plot_ly(starwars_data_filtered(),
              source = 'scatter') %>%
        add_markers(
          x = ~height,
          y = ~homeworld,
          color = ~factor(gender),
          key = ~ID
        ) %>%
        layout(
          xaxis = list(title = 'Height', rangemode = "tozero"),
          yaxis = list(title = 'Homeland', rangemode = "tozero"),
          dragmode = "select"
        )
  })

}
shinyApp(ui, srv)
于 2017-11-22T11:12:24.150 回答