プロットで観測を差し引いているときに、データテーブルに必要な列のみを表示する方法を見つけようとしています。これが私のコードです:
library(shiny)
library(dplyr)
library(DT)
library(plotly)
# 1) Prepare layout
hair = starwars %>%
select(hair_color) %>%
arrange(hair_color) %>%
distinct()
spec = starwars %>%
select(species) %>%
arrange(species) %>%
distinct()
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput('hair', 'Hair', hair, multiple = TRUE),
selectInput('spec', 'Species', spec, multiple = TRUE),
htmlOutput('txt')
),
mainPanel(
plotlyOutput('plot'),
dataTableOutput('table')
)
)
)
# 2) Prepare data
srv <- function(input, output){
starwars_data <- reactive({
starwars_data_as_table <- as.data.frame(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'
# a) 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
})
# filter data using input box
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({
# need to keep all columns from the original dataframe
# to have necessary info for output$txt
sel_data = starwars_data_filtered()
ed = event_data("plotly_selected", source = "scatter")
if(!is.null(ed)){
sel_data = sel_data %>%
filter(ID %in% ed$key)
}
sel_data
})
output$table = renderDataTable({
d = selected_data()
# column names to show in datatable
columns2show <- c("ID", "Name", "Height", "Weight", "Hair", "Birth",
"Number of movies", "Number of vehicles", "Number of starships")
# column indexes to hide in datatable
columns2hide <- which(!(colnames(selected_data()) %in% columns2show))
if(!is.null(d)){
datatable(d, selection = 'single', rownames = FALSE,
## columns to hide ##
options = list(columnDefs = list(list(visible = FALSE, targets = columns2hide))))
}
})
output$txt = renderText({
row_count <- input$table_rows_selected
if(!is.null(row_count)){
# a function to create a list from the vector
vectorBulletList <- function(vector) {
if(length(vector > 1)) {
paste0("<ul><li>",
paste0(
paste0(vector, collpase = ""), collapse = "</li><li>"),
"</li></ul>")
}
}
# need to subset dataframe that reacts to selecting points on plot
# change starwars_data() to selected_data()
# in starwars dataframe, vehicles and starships are lists
# need to select the first element of the list (the character vector)
vehicles <- selected_data()[row_count, "Vehicles"][[1]]
starships <- selected_data()[row_count, "Starship"][[1]]
movies <- selected_data()[row_count, "Movies"][[1]]
paste("Name: ", "<b>",selected_data()[row_count,"Name"],"<br>","</b>",
"Gender: ", "<b>",selected_data()[row_count,"Gender"],"<br>","</b>",
"Birth: ", "<b>",selected_data()[row_count,"Birth"],"<br>","</b>",
"Homeworld: ", "<b>",selected_data()[row_count,"Homeworld"],"<br>","</b>",
"Species: ", "<b>",selected_data()[row_count,"Species"],"<br>","</b>",
"Height: ", "<b>",selected_data()[row_count,"Height"],"<br>","</b>",
"Weight: ", "<b>",selected_data()[row_count,"Weight"],"<br>","</b>",
"Hair: ", "<b>",selected_data()[row_count,"Hair"],"<br>","</b>",
"Skin: ", "<b>",selected_data()[row_count,"Skin"],"<br>","</b>",
"Eyes: ", "<b>",selected_data()[row_count,"Eyes"],"<br>","</b>",
"<br>",
"Vehicles: ", "<b>", vectorBulletList(vehicles),"<br>","</b>",
"<br>",
"Starship: ", "<b>", vectorBulletList(starships),"<br>","</b>",
"<br>",
"Movies: ", "<b>", vectorBulletList(movies),"<br>","</b>")
}
})
}
shinyApp(ui, srv)
定義された列のみを表示したい (「ID」、「名前」、「身長」、「体重」、「髪」、「出生」、「映画の数」、「車両の数」、「宇宙船の数」) ) プロット上のデータを差し引いているとき。しかし、「誕生」の代わりに「性別」があり、見せたくない「肌」と「映画の数」が完全に欠落しています。なぜこれが起こるのですか？