如何将 htmlOutput 的矢量更改为项目符号列表？单击数据表行后，我想了解每个角色的详细特征，其中应从项目符号点开始列出车辆、星舰和电影。这是我的代码，抱歉它有点乱，我不久前才开始我的 R 之旅。
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
})
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)){
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>",starwars_data()[row_count,"Vehicles"],"<br>","</b>",
"<br>",
"Starship: ", "<b>",starwars_data()[row_count,"Starship"],"<br>","</b>",
"<br>",
"Movies: ", "<b>",starwars_data()[row_count,"Movies"],"<br>","</b>")
}
})
}
shinyApp(ui, srv)
最佳答案
这是一个将向量转换为 bulleted list in HTML 的函数:
## write a function to turn a vector into bulleted list
vectorBulletList <- function(vector) {
if(length(vector > 1)) {
paste0("<ul><li>",
paste0(
paste0(vector, collpase = ""), collapse = "</li><li>"),
"</li></ul>")
}
}
# example
testVector <- c("apple", "orange", "banana", "pineapple")
vectorBulletList(testVector)
但是，您的代码 (starwars_data()[row_count, "Movies"]) 返回一个列表而不是字符向量。如果我们查看 starwars 数据框中的 films、vehicles 和 starships 列的类，我们会看到它们都是列表。从 films 列中选择一个观察结果会返回长度为 1 的列表。因此，我们需要选择列表的第一个元素来返回字符向量。
## class of starwars columns: films, vehicles, starships
starwars_data <- as.data.frame(starwars)
sapply(starwars_data[, c("films", "vehicles", "starships")], class)
## class and length of one observation from films column
class(starwars_data[1, "films"])
length(starwars_data[1, "films"])
## select first element of list to return character vector
class(starwars_data[1, "films"][[1]])
starwars_data[1, "films"][[1]]
我们可以将这些全部放在您的脚本中，如下所示:
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
})
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)){
# write 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)
关于r - 如何将 htmlOutput 的向量更改为项目符号列表？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/47556388/