html 输出或数据 table。哪个不能正常刷新?
htmlOutput or data table. Which does not refresh properly?
我想弄清楚我的代码有什么问题。这是怎么回事:
当我第一次 运行 它并单击数据 table 行时,我可以看到所有字符信息,因为它们应该是这样的。但是当我在图上选择其他几个观察结果并再次单击同一行时,它仍然会提供关于之前那个地方的那个的信息(例如第一行 -> 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)
问题
您的数据表基于 selected_data()
数据框(当您在图上 select 点时更新),但是您在 [=16] 中对原始 starwars_data()
数据框进行子集化=].您正在从与用于数据表的数据框中不同的数据框中获取行。所以我们需要在 output$txt
.
中使用 selected_data()
但是,selected_data()
不包含生成 output$txt
所需的所有列(例如电影、星际飞船、交通工具)。我们可以只 .
而不是在定义 selected_data()
时选择列的子集
解决方案
首先,我们将获取要隐藏的列的索引。这是我们如何做到这一点的示例:
### 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
编辑: 正如 krakowi 指出的那样,我们的列索引基于 R,但数据表是用 javascript 生成的。由于 R 从 1 开始计数,但 javascript 从 0 开始计数,因此原始答案在数据表中抓取了不正确的列。因此,我们需要从 columns2hide 中减去 1,以便在按 javascript 计数时获得正确的列索引。见下文:
columns2hide <- columns2hide - 1
然后,我们需要通过添加 options
:
从数据表中隐藏这些列
datatable(d, selection = 'single', rownames = FALSE,
## columns to hide ##
options = list(columnDefs = list(list(visible = FALSE, targets = columns2hide))))
最后,在 output$txt
中,我们需要将 starwars_data()
更改为 selected_data()
,以便我们从正确的数据框中抓取行。
例子
让我们把它们放在一起:
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)
我想弄清楚我的代码有什么问题。这是怎么回事:
当我第一次 运行 它并单击数据 table 行时,我可以看到所有字符信息,因为它们应该是这样的。但是当我在图上选择其他几个观察结果并再次单击同一行时,它仍然会提供关于之前那个地方的那个的信息(例如第一行 -> 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)
问题
您的数据表基于 selected_data()
数据框(当您在图上 select 点时更新),但是您在 [=16] 中对原始 starwars_data()
数据框进行子集化=].您正在从与用于数据表的数据框中不同的数据框中获取行。所以我们需要在 output$txt
.
selected_data()
但是,selected_data()
不包含生成 output$txt
所需的所有列(例如电影、星际飞船、交通工具)。我们可以只
selected_data()
时选择列的子集
解决方案
首先,我们将获取要隐藏的列的索引。这是我们如何做到这一点的示例:
### 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
编辑: 正如 krakowi 指出的那样,我们的列索引基于 R,但数据表是用 javascript 生成的。由于 R 从 1 开始计数,但 javascript 从 0 开始计数,因此原始答案在数据表中抓取了不正确的列。因此,我们需要从 columns2hide 中减去 1,以便在按 javascript 计数时获得正确的列索引。见下文:
columns2hide <- columns2hide - 1
然后,我们需要通过添加 options
:
datatable(d, selection = 'single', rownames = FALSE,
## columns to hide ##
options = list(columnDefs = list(list(visible = FALSE, targets = columns2hide))))
最后,在 output$txt
中,我们需要将 starwars_data()
更改为 selected_data()
,以便我们从正确的数据框中抓取行。
例子
让我们把它们放在一起:
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)