2つの異なるセレクト入力からのプロットデータ

Question

私は光栄であり、反応が少なく、宿題をやっています。私は次の問題を解決する方法を理解できません。私はデフォルトで、x軸が高さでy軸が（今のように）ホームワールドであるすべての性別を示すプロットを持っていきたいと思います。それから私は私のプロットの条件を選ぶことができる場所から2つのマルチセレクト入力をしたいと思います。例えば、私が白い髪（または他のいくつかのタイプ）を選択すると、髪に適用された観察のみが表示されるはずです（同様に種について）。しかし、私が茶色の髪と人間の種を選ぶとき、それは両方の条件を満たす観察に私を指すべきです。デフォルトでは、プロットは、x軸上の高さでy軸がホームワールドのときのすべての観測値を表示する必要があります。これまで私が行ってきたことがあります。

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データフレームを使用している

• はあなたが

をフィルタリングするために、2つの異なる反応性の機能を必要としない選択

• にもかかわらず変わらず

• リアクティブエレメントにアクセスするのはアクセス機能のようなものなので、プロットに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)