Question

我不熟悉Shiny和反应性并做我的功课。我无法弄清楚如何解决以下问题。我想有一个情节，默认显示所有性别，其中x轴是高度，y轴是家庭世界（现在是）。然后我想有两个多选输入，我可以在那里为我的情节选择条件。例如，当我选择白发（或其他几种类型）时，我应该只看到我申请发型的观察结果（类似于物种）。但是，当我选择棕色头发和人类物种时，它应该指向符合这两个条件的观察结果。默认情况下，绘图应显示所有观察结果，当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)

感谢您的任何提示。

Answer 1

一些事情：

您使用相同的输入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)

Answer 2

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

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)

绘制来自两个不同选择输入的数据

2 个答案: