I am trying to figure out what is wrong with my code.. Here what is going on:
When I run it for the first time and click on data table row I can see all character information as they should be. But then when I am selecting several other observations on the plot and click again on the same row, it still gives info about the one which was on that place previously (eg for the 1st row -> Luke Skywalker).
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({
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")
if(!is.null(ed)){
sel_data = sel_data %>%
filter(ID %in% ed$key)
}
sel_data
})
output$table = renderDataTable({
d = selected_data()
if(!is.null(d)){
datatable(d, selection = 'single', rownames = FALSE)
}
})
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>")
}
}
# in starwars dataframe, vehicles and starships are lists
# need to select the first element of the list (the character vector)
vehicles <- starwars_data()[row_count, "Vehicles"][[1]]
starships <- starwars_data()[row_count, "Starship"][[1]]
movies <- starwars_data()[row_count, "Movies"][[1]]
paste("Name: ", "<b>",starwars_data()[row_count,"Name"],"<br>","</b>",
"Gender: ", "<b>",starwars_data()[row_count,"Gender"],"<br>","</b>",
"Birth: ", "<b>",starwars_data()[row_count,"Birth"],"<br>","</b>",
"Homeworld: ", "<b>",starwars_data()[row_count,"Homeworld"],"<br>","</b>",
"Species: ", "<b>",starwars_data()[row_count,"Species"],"<br>","</b>",
"Height: ", "<b>",starwars_data()[row_count,"Height"],"<br>","</b>",
"Weight: ", "<b>",starwars_data()[row_count,"Weight"],"<br>","</b>",
"Hair: ", "<b>",starwars_data()[row_count,"Hair"],"<br>","</b>",
"Skin: ", "<b>",starwars_data()[row_count,"Skin"],"<br>","</b>",
"Eyes: ", "<b>",starwars_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)
Problem
Your datatable is based on the selected_data() dataframe (which updates when you select points on your plot), but you're subsetting the original starwars_data() dataframe in output$txt. You're grabbing the row from a different dataframe than the one used for your datatable. So we'll need to use selected_data() in output$txt.
However, selected_data() doesn't contain all of the necessary columns (e.g. Movies, Starship, Vehicles) to produce your output$txt. Instead of choosing a subset of columns when you define selected_data(), we can just hide the columns from the datatable output.
Solution
First, we'll get the index of the columns we want to hide. Here's an example of how we'd do that:
### select columns to remove based on columns we want to show ###
columns2show <- c("name", "birth_year", "mass", "vehicles") # columns to show
columns2hide <- which(!(colnames(starwars) %in% columns2show)) # column index to hide
colnames(starwars)[columns2hide] # check hidden columns
Edit: As krakowi pointed out, our column indexes are based on R, but the datatable is generated with javascript. Since R starts counting at 1, but javascript starts at 0, the original answer grabbed the incorrect columns in the datatable. So we'll need to subtract 1 from columns2hide to get the correct column indexes when counted by javascript. See below:
columns2hide <- columns2hide - 1
Then, we'll need to hide these columns from the datatable by adding options:
datatable(d, selection = 'single', rownames = FALSE,
## columns to hide ##
options = list(columnDefs = list(list(visible = FALSE, targets = columns2hide))))
Finally, in output$txt, we'll need to change starwars_data() to selected_data() so we're grabbing the row from the correct dataframe.
Example
Let's put it all together:
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 - subtract one to account for JS indexing
columns2hide <- which(!(colnames(selected_data()) %in% columns2show))
columns2hide <- columns2hide - 1
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)