2017-11-27 7 views
0

データテーブルの入力ボックスから選択したデータを表示し、プロットに同時に表示するにはどうしたらいいですか?現在、私はデータを選択してプロット上に観測値を表示することができます。プロット上にドラッグしてマークしてテーブルに表示することもできますが、これもフィルタリングすることができます私のデータを選択した入力で表示し、それをプロットとテーブルに同時に表示します。 output$tableに別の条件を追加しなければならないと確信していますが、入力から選択することもドラッグすることもできます。ここで私はこれまでやっていることです:私はSRVで論争と操作すべてのデータを入れて、UIにのみUIオブジェクトを残して経験則として選択した入力のデータをプロットとテーブルに同時に表示できません(同時に)

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


# Step 1 - prepare row data 

# a) replace NA values in columns 

starwars_data_as_table <- as_tibble(starwars) 
starwars_data_as_table = starwars_data_as_table %>% 
    tibble::rownames_to_column(var = 'ID') 

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(
    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) 
) 

colnames(starwars_data) <- c("ID", "Name","Height", "Weight", 
          "Hair","Skin","Eyes", 
          "Birth", "Gender", 
          "Homeworld","Species", "movies", 
          "Vehicles", "Starship", "Number of movies", 
          "Number of vehicles", "Number of starships") 


starwars_data2 = starwars_data %>% 
    select(ID, 
     Name, 
     Height, 
     Weight, 
     Hair, 
     'Birth', 
     'Number of movies', 
     'Number of vehicles', 
     'Number of starships') 


# 2) Prepare layout 

hair = starwars_data %>% 
    select(Hair) %>% 
    arrange(Hair) %>% 
    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'), 
     dataTableOutput('table') 
    ) 
) 
) 


srv <- function(input, output){ 


    starwars_data_filtered <- reactive({ 

    if(length(input$hair) > 0){ 
     starwars_data <- starwars_data %>% 
     filter(Hair %in% input$hair) 
    } 
    if (length(input$spec) > 0) { 
     starwars_data <- starwars_data %>% 
     filter(Species %in% input$spec) 
    } 
    if (length(input$spec) > 0 & length(input$hair) > 0) { 
     starwars_data <- starwars_data %>% 
     filter(Hair %in% input$hair) %>% 
     filter(Species %in% input$spec) 
    } 
    starwars_data 
    }) 



    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" 
    ) 
    }) 


    selected_data = reactive({ 
    sel_data = NULL 
    ed = event_data("plotly_selected", source = "scatter") 

    if(!is.null(ed)){ 
     sel_data = starwars_data2 %>% 
     filter(ID %in% ed$key)  
    } else { 
     sel_data = starwars_data2 
    } 
    sel_data 
    }) 

    output$table = renderDataTable({ 
    d = selected_data() 
    e = starwars_data_filtered() 
    if(!is.null(d)){ 
     datatable(d, selection = 'single', rownames = FALSE) 
    } 
    # if(!is.null(e)){ 
    # datatable(e, selection = 'single', rownames = FALSE) 
    # } 
    }) 


} 
shinyApp(ui, srv) 

答えて

0

アレックスが既に言及したように、データをサーバーに配置する必要があります。以下は、あなたのコードの実際のバージョンです。どのように反応表現の連鎖がありますか。これはあなたが輝くように使用したいと思うdesingです。反応変数は有用ではなく、複数の場所で呼び出されてもすべての引数が同じである限り、一度だけ計算されます。

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


# 2) Prepare layout 

hair = starwars_data %>% 
    select(Hair) %>% 
    arrange(Hair) %>% 
    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'), 
     dataTableOutput('table') 
    ) 
) 
) 


srv <- function(input, output){ 

    starwars_data <- reactive({ 
    # Step 1 - prepare row data 

    # a) replace NA values in columns 

    starwars_data_as_table <- as_tibble(starwars) 
    starwars_data_as_table = starwars_data_as_table %>% 
     tibble::rownames_to_column(var = 'ID') 

    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(
     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) 
    ) 

    colnames(starwars_data) <- c("ID", "Name","Height", "Weight", 
           "Hair","Skin","Eyes", 
           "Birth", "Gender", 
           "Homeworld","Species", "movies", 
           "Vehicles", "Starship", "Number of movies", 
           "Number of vehicles", "Number of starships") 
    starwars_data 

    }) 


    starwars_data_filtered <- reactive({ 

    dta <- starwars_data() 
    if(length(input$hair) > 0){ 
     dta <- dta %>% 
     filter(Hair %in% input$hair) 
    } 
    if (length(input$spec) > 0) { 
     dta <- dta %>% 
     filter(Species %in% input$spec) 
    } 
    if (length(input$spec) > 0 & length(input$hair) > 0) { 
     dta <- dta %>% 
     filter(Hair %in% input$hair) %>% 
     filter(Species %in% input$spec) 
    } 
    dta 
    }) 



    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" 
    ) 
    }) 


    selected_data = reactive({ 
    sel_data = starwars_data_filtered() %>% 
     select(ID, 
      Name, 
      Height, 
      Weight, 
      Hair, 
      'Birth', 
      'Number of movies', 
      'Number of vehicles', 
      'Number of starships') 
    ed = event_data("plotly_selected", source = "scatter") 
    browser() 
    if(!is.null(ed)){ 
     sel_data = sel_data %>% 
     filter(ID %in% ed$key)  
    } 
    sel_data 
    }) 

    output$table = renderDataTable({ 
    d = selected_data() 
    e = starwars_data_filtered() 
    if(!is.null(d)){ 
     datatable(d, selection = 'single', rownames = FALSE) 
    } 
    # if(!is.null(e)){ 
    # datatable(e, selection = 'single', rownames = FALSE) 
    # } 
    }) 


} 
shinyApp(ui, srv) 

これが役に立ちます。

+0

ありがとうございました!私はそれをもっとはっきりと見ています。事は、Rと光沢が私には新しく、あなたのヒントは私にそれをよりよく理解するのを助けます。 – krakowi

0

。私はあなたが正しい道にいると思う。私はあなたのコードで少し混乱しています。あなたは "髪"と呼ばれる入力を持っていますが、hairというデータフレームも作成していますが、 "Hair"(大文字)でフィルタリングしようとしています。

あなたはUIの入力を使用するには、プロットやデータテーブルをする場合

が、これは1つの反応式で行うことができます。反応式を使用して、ui入力をフィルタリングする新しいデータフレームを作成します。次に、このデータフレーム(starwars_data_filtered())をプロットとデータ出力で使用します。

関連する問題