ggplot 与来自数据表 (DT) 的过滤数据和反应性小部件来选择 x 和 y 轴
ggplot with filtered data from datatable (DT) and reactive widgets to choose x and y axis
我想使用数据表中过滤后的数据来创建一个 ggplot。我还实现了两个小部件,它们在过滤数据表后将允许用户选择要显示的 x 和 y 轴。设置小部件等后我得到一个错误:
Error in `[.data.frame`(data_melt, filtered_data) : undefined columns selected
我不知道为什么会这样。
我的数据示例:
Rundheit Diff Charge Ord..Nr. Block.Nr.
1 0.24 0.20 754331 738 1
2 0.26 0.21 783345 738 2
3 0.25 0.15 795656 738 3
4 NA 0.14 798431 738 4
5 NA 0.12 799651 738 5
6 0.24 NA 805454 738 6
NA 值必须保留在我的数据中
UI:
ui <- dashboardPage(
dashboardHeader(title = "WW"),
dashboardSidebar(
selectizeInput(inputId = "yaxis",
label = "Y-axis (Diagramm)",
choices = list("Rundheit" = "Rundheit",
"Diff" = "Diff"),
selected = c("Rundheit"), multiple=TRUE),
selectInput(inputId = "xaxis",
label = "X-axis (Diagramm)",
choices = names(data_melt),
selected = "Block.Nr.")
),
dashboardBody(
fluidRow(
tabBox(status = "primary", width = NULL, height = "1000px",
tabPanel(title="Tabelle filtern", div(style = 'overflow-y: scroll; max-height: 950px; position:relative;',
dataTableOutput("tabelle"))),
tabPanel("Diagramm", plotOutput("plot1")),
tabPanel("Histogramm", plotOutput("plot2"))))
))
服务器:
server <- function(input, output, session) {
output$tabelle <- renderDataTable({
datatable(data[, c("Rundheit", "Diff", "Charge.", "Ord..Nr.", "Block.Nr.")], class = 'cell-border stripe',
rownames=FALSE, filter="top",
options = list(lengthChange = FALSE, columnDefs = list(list(width = '200px', targets = "_all"), list(bSortable = FALSE, targets = "_all"))), callback=JS("
//hide column filters for two columns
$.each([0, 1], function(i, v) {
$('input.form-control').eq(v).hide()});",
"var tips = ['Rundheit', 'Diff', 'Charge',
'Ord..Nr.', 'Block.Nr.'],
header = table.columns().header();
for (var i = 0; i < tips.length; i++) {
$(header[i]).attr('title', tips[i]);}")) %>%
formatStyle("Rundheit", color = 'red', backgroundColor = 'lightyellow', fontWeight = 'bold')
})
output$plot1 <- renderPlot({
filtered_data <- input$tabelle_rows_all
data_filt <- data_melt[filtered_data]
ggplot(data=data_filt, aes_string(x = input$xaxis, y = input$yaxis), environment = environment())+ geom_line(aes(group=1), size=1) +
theme(axis.text.y=element_text(size=15), axis.text.x=element_text(size=15), axis.title.x = element_text(size=18, face="bold"),axis.title.y = element_text(size=18, face="bold"))
})
}
shinyApp(ui = ui, server = server)
有谁知道为什么它不起作用,然后我如何定义列。
所以你的代码有点 "messy",有一些编译错误,一些遗漏的代码,我不得不手动输入你的数据。不是每个人都会那样做...我也不确定 data
和 data_melt
应该发生在哪里,所以我只是选择了 data_melt
。无论如何我让它工作了,我不得不承认这是一个强大而迷人的功能。我希望这是你想要的,虽然我没有看到你所有的错误信息 per-se.
您的主要错误是设置 rownames=F
,因为 input$tabelle_rows_all
用来过滤 table 的行名。我还在 ggplot
调用中添加了一个 nrow
守卫,以防止它在空数据帧上阻塞。
这是工作代码:
library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(DT)
rr <- c(0.24,0.26,0.25,NA,NA,0.24)
dd <- c(0.20,0.21,0.15,0.14,0.12,NA)
cc <- c(74331,783345,795656,798431,799651,805454)
oo <- rep(738,6)
bb <- 1:6
data_melt <- data.frame(Rundheit=rr,Diff=dd,Charge.=cc,Ord..Nr.=oo,Block.Nr.=bb)
ui <- dashboardPage(
dashboardHeader(title = "WW"),
dashboardSidebar(
selectizeInput(inputId = "yaxis",
label = "Y-axis (Diagramm)",
choices = list("Rundheit" = "Rundheit",
"Diff" = "Diff"),
selected = c("Rundheit"), multiple=TRUE),
selectInput(inputId = "xaxis",
label = "X-axis (Diagramm)",
choices = names(data_melt),
selected = "Block.Nr.")
),
dashboardBody(
fluidRow(
tabBox(status = "primary", width = NULL, height = "1000px",
tabPanel(title="Tabelle filtern",
div(style = 'overflow-y: scroll; max-height: 950px; position:relative;',
dataTableOutput("tabelle"))),
tabPanel("Diagramm", plotOutput("plot1")),
tabPanel("Histogramm", plotOutput("plot2"))))
))
server <- function(input, output, session) {
output$tabelle <- renderDataTable({
datatable(data_melt[, c("Rundheit", "Diff", "Charge.", "Ord..Nr.", "Block.Nr.")],
class = 'cell-border stripe',
filter="top",
options = list(lengthChange = FALSE,
columnDefs = list(list(width = '200px', targets = "_all"),
list(bSortable = FALSE, targets = "_all"))),
callback=JS("
//hide column filters for two columns
$.each([0, 1], function(i, v) {
$('input.form-control').eq(v).hide()});
var tips = ['Rundheit', 'Diff', 'Charge',
'Ord..Nr.', 'Block.Nr.'],
header = table.columns().header();
for (var i = 0; i < tips.length; i++) {
$(header[i]).attr('title', tips[i]);}")) %>%
formatStyle("Rundheit", color='red', backgroundColor='lightyellow', fontWeight='bold')
})
output$plot1 <- renderPlot({
filtered_data <- input$tabelle_rows_all
data_filt <- data_melt[filtered_data,]
if (nrow(data_filt>0)){
g <-ggplot(data=data_filt, aes_string( x=input$xaxis, y=input$yaxis),
environment=environment())+
geom_line(aes(group=1), size=1) +
theme(axis.text.y=element_text(size=15),
axis.text.x=element_text(size=15),
axis.title.x = element_text(size=18, face="bold"),
axis.title.y = element_text(size=18, face="bold"))
return(g)
} else {
return(NULL)
}
})
}
shinyApp(ui = ui, server = server)
这里有几个屏幕截图显示它正在运行:
产量:
我想使用数据表中过滤后的数据来创建一个 ggplot。我还实现了两个小部件,它们在过滤数据表后将允许用户选择要显示的 x 和 y 轴。设置小部件等后我得到一个错误:
Error in `[.data.frame`(data_melt, filtered_data) : undefined columns selected
我不知道为什么会这样。
我的数据示例:
Rundheit Diff Charge Ord..Nr. Block.Nr.
1 0.24 0.20 754331 738 1
2 0.26 0.21 783345 738 2
3 0.25 0.15 795656 738 3
4 NA 0.14 798431 738 4
5 NA 0.12 799651 738 5
6 0.24 NA 805454 738 6
NA 值必须保留在我的数据中
UI:
ui <- dashboardPage(
dashboardHeader(title = "WW"),
dashboardSidebar(
selectizeInput(inputId = "yaxis",
label = "Y-axis (Diagramm)",
choices = list("Rundheit" = "Rundheit",
"Diff" = "Diff"),
selected = c("Rundheit"), multiple=TRUE),
selectInput(inputId = "xaxis",
label = "X-axis (Diagramm)",
choices = names(data_melt),
selected = "Block.Nr.")
),
dashboardBody(
fluidRow(
tabBox(status = "primary", width = NULL, height = "1000px",
tabPanel(title="Tabelle filtern", div(style = 'overflow-y: scroll; max-height: 950px; position:relative;',
dataTableOutput("tabelle"))),
tabPanel("Diagramm", plotOutput("plot1")),
tabPanel("Histogramm", plotOutput("plot2"))))
))
服务器:
server <- function(input, output, session) {
output$tabelle <- renderDataTable({
datatable(data[, c("Rundheit", "Diff", "Charge.", "Ord..Nr.", "Block.Nr.")], class = 'cell-border stripe',
rownames=FALSE, filter="top",
options = list(lengthChange = FALSE, columnDefs = list(list(width = '200px', targets = "_all"), list(bSortable = FALSE, targets = "_all"))), callback=JS("
//hide column filters for two columns
$.each([0, 1], function(i, v) {
$('input.form-control').eq(v).hide()});",
"var tips = ['Rundheit', 'Diff', 'Charge',
'Ord..Nr.', 'Block.Nr.'],
header = table.columns().header();
for (var i = 0; i < tips.length; i++) {
$(header[i]).attr('title', tips[i]);}")) %>%
formatStyle("Rundheit", color = 'red', backgroundColor = 'lightyellow', fontWeight = 'bold')
})
output$plot1 <- renderPlot({
filtered_data <- input$tabelle_rows_all
data_filt <- data_melt[filtered_data]
ggplot(data=data_filt, aes_string(x = input$xaxis, y = input$yaxis), environment = environment())+ geom_line(aes(group=1), size=1) +
theme(axis.text.y=element_text(size=15), axis.text.x=element_text(size=15), axis.title.x = element_text(size=18, face="bold"),axis.title.y = element_text(size=18, face="bold"))
})
}
shinyApp(ui = ui, server = server)
有谁知道为什么它不起作用,然后我如何定义列。
所以你的代码有点 "messy",有一些编译错误,一些遗漏的代码,我不得不手动输入你的数据。不是每个人都会那样做...我也不确定 data
和 data_melt
应该发生在哪里,所以我只是选择了 data_melt
。无论如何我让它工作了,我不得不承认这是一个强大而迷人的功能。我希望这是你想要的,虽然我没有看到你所有的错误信息 per-se.
您的主要错误是设置 rownames=F
,因为 input$tabelle_rows_all
用来过滤 table 的行名。我还在 ggplot
调用中添加了一个 nrow
守卫,以防止它在空数据帧上阻塞。
这是工作代码:
library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(DT)
rr <- c(0.24,0.26,0.25,NA,NA,0.24)
dd <- c(0.20,0.21,0.15,0.14,0.12,NA)
cc <- c(74331,783345,795656,798431,799651,805454)
oo <- rep(738,6)
bb <- 1:6
data_melt <- data.frame(Rundheit=rr,Diff=dd,Charge.=cc,Ord..Nr.=oo,Block.Nr.=bb)
ui <- dashboardPage(
dashboardHeader(title = "WW"),
dashboardSidebar(
selectizeInput(inputId = "yaxis",
label = "Y-axis (Diagramm)",
choices = list("Rundheit" = "Rundheit",
"Diff" = "Diff"),
selected = c("Rundheit"), multiple=TRUE),
selectInput(inputId = "xaxis",
label = "X-axis (Diagramm)",
choices = names(data_melt),
selected = "Block.Nr.")
),
dashboardBody(
fluidRow(
tabBox(status = "primary", width = NULL, height = "1000px",
tabPanel(title="Tabelle filtern",
div(style = 'overflow-y: scroll; max-height: 950px; position:relative;',
dataTableOutput("tabelle"))),
tabPanel("Diagramm", plotOutput("plot1")),
tabPanel("Histogramm", plotOutput("plot2"))))
))
server <- function(input, output, session) {
output$tabelle <- renderDataTable({
datatable(data_melt[, c("Rundheit", "Diff", "Charge.", "Ord..Nr.", "Block.Nr.")],
class = 'cell-border stripe',
filter="top",
options = list(lengthChange = FALSE,
columnDefs = list(list(width = '200px', targets = "_all"),
list(bSortable = FALSE, targets = "_all"))),
callback=JS("
//hide column filters for two columns
$.each([0, 1], function(i, v) {
$('input.form-control').eq(v).hide()});
var tips = ['Rundheit', 'Diff', 'Charge',
'Ord..Nr.', 'Block.Nr.'],
header = table.columns().header();
for (var i = 0; i < tips.length; i++) {
$(header[i]).attr('title', tips[i]);}")) %>%
formatStyle("Rundheit", color='red', backgroundColor='lightyellow', fontWeight='bold')
})
output$plot1 <- renderPlot({
filtered_data <- input$tabelle_rows_all
data_filt <- data_melt[filtered_data,]
if (nrow(data_filt>0)){
g <-ggplot(data=data_filt, aes_string( x=input$xaxis, y=input$yaxis),
environment=environment())+
geom_line(aes(group=1), size=1) +
theme(axis.text.y=element_text(size=15),
axis.text.x=element_text(size=15),
axis.title.x = element_text(size=18, face="bold"),
axis.title.y = element_text(size=18, face="bold"))
return(g)
} else {
return(NULL)
}
})
}
shinyApp(ui = ui, server = server)
这里有几个屏幕截图显示它正在运行:
产量: