[英]Unable to display data from select input on the plot and in the table (at the same time)
如何在数据表的输入框中显示所选数据，并同时在绘图上显示它们？ 目前，我可以选择数据并在图上显示观测值，也可以在图上拖动并标记它们以显示在表格中（这也是我想要做的），但我也希望能够进行过滤我在选择输入中的数据，并同时将其显示在绘图和表格中。 我确定在output$table必须添加另一个条件，但是我尝试过，可以从输入中选择，也可以通过拖动来选择。 到目前为止，这是我所做的：
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)
根据经验，我会将所有数据整理和操作都放在srv中，而只在UI中保留UI对象。 我认为您在正确的轨道上。 我对您的代码有点困惑。 您有一个名为“ hair”的输入，但是您也正在创建一个名为hair的数据框，但是随后您尝试过滤“ Hair”（大写）。
如果要让图表和数据表使用ui输入，则可以使用1个反应表达式来完成。 使用反应表达式创建一个新的数据框，该数据框将在ui输入上进行过滤。 然后在绘图和数据表输出中使用此数据框（starwars_data_filtered（））。
如Alex所述，您应该将数据整理在服务器中。 以下是您的代码的有效版本。 请不要有反应式表达的链。 这是您要用于闪亮的设计。 只要所有参数保持相同，即使在多个位置调用，反应式也仅对一次计算有用。
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)
希望这可以帮助！
如何从单个数据表/数据框在同一图上绘制两条线
[英]How to plot two lines on a same plot, from a single data table/ data frame
Select 行从一个表到另一个然后 plot 来自第二个表的数据 R Shiny
[英]Select rows from one table to another then plot the data from the second table R Shiny
如何从输入 $ 访问 R 应用程序中的矩阵。 我想显示表格和 plot 置信区间
[英]How to access a matrix in an R application from the input $. I would like to display the table and plot confidence interval
R闪亮：使用输入参数从数据框中选择和显示值
[英]R Shiny: Using input parameters to select and display value from data frame
声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.