gpt4 book ai didi

shinydashboard - Highcharter - 单击事件以从图表中过滤数据

转载 作者:行者123 更新时间:2023-12-05 03:06:44 26 4
gpt4 key购买 nike

我正在使用 highcharter,我希望能够在我点击一个栏(无论是顶层还是下钻)时向我的图表添加一个 click 事件 , 它过滤它下面的数据表以包含相同的信息。

我已经检查了这个 SO 问题,它显示了如何将 Java 实现到 R 以包含点击功能,但没有检查如何使用该信息来过滤数据/选择正确的数据集。

Hyperlink bar chart in Highcharter

任何帮助将不胜感激!示例代码如下:

library (shiny)
library (shinydashboard)
library (dplyr)
library (tibble)
library (highcharter)
library(shinyjs)
library (DT)

rm(list=ls())
header <- dashboardHeader()
sidebar <- dashboardSidebar()

body <- dashboardBody(
fluidRow(
box(
tags$head(tags$style(HTML("#OnTime{height:25vh !important;} "))),
title = "On Time", status = "primary", solidHeader = TRUE, width = 6,
highchartOutput("OnTime")
)
),
fluidRow(
box(
title = "WIP Table", status = "primary", solidHeader = TRUE,
DT::dataTableOutput("Table")
)
)
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {

Customer <- c("England", "France", "US", "Canada", "England", "France", "US", "Canada", "England")
OnTime <- c("On Time", "On Time", "Overdue", "On Time", "Overdue", "On Time", "Overdue","On Time", "On Time")
Gate <- c(1,2,3,2,3,2,1,2,3)
Quantity <- c(1,1,1,1,1,1,1,1,1)

data <- data.frame(Customer,OnTime,Gate, Quantity)

output$OnTime <- renderHighchart({

Lvl1GroupingStatus <- aggregate(data$Quantity, by = list(data$OnTime),FUN=sum)
Lvl1dfStatus <- data_frame(name = Lvl1GroupingStatus$Group.1,y = Lvl1GroupingStatus$x,drilldown = tolower(name))

Lvl2WIPOverDue <- data[data$OnTime == "Overdue",]
Lvl2WIPOverDueb <- aggregate(Lvl2WIPOverDue$Quantity, by = list(Lvl2WIPOverDue$Customer),FUN=sum)
Lvl2dfWIPOverDue <- arrange(data_frame(name = Lvl2WIPOverDueb$Group.1,value = Lvl2WIPOverDueb$x),desc(value))

Lvl2WIPOnTime <- data[data$OnTime == "On Time",]
Lvl2WIPOnTimeb <- aggregate(Lvl2WIPOnTime$Quantity, by = list(Lvl2WIPOnTime$Customer),FUN=sum)
Lvl2dfWIPOnTime <- arrange(data_frame(name = Lvl2WIPOnTimeb$Group.1,value = Lvl2WIPOnTimeb$x),desc(value))

highchart() %>%
hc_chart(type = "column") %>%
hc_xAxis(type = "category") %>%
hc_legend(enabled = FALSE) %>%
hc_yAxis(gridLineWidth = 0) %>%
hc_plotOptions(series = list(column = list(stacking = "normal"), borderWidth=0,dataLabels = list(enabled = TRUE))) %>%
hc_add_series(data=Lvl1dfStatus,name="Status", colorByPoint = TRUE,colors = c("#003395","#D20000")) %>%

hc_drilldown(
allowPointDrilldown = TRUE,
series = list(
list(id = "overdue", data = list_parse2(Lvl2dfWIPOverDue), name="Customer"),
list(id = "on time", data = list_parse2(Lvl2dfWIPOnTime), name="Customer")

)
)
})


output$Table <- DT::renderDataTable({ data})

}

#Combines Dasboard and Data together
shinyApp(ui, server)

最佳答案

在这篇 SO 帖子的帮助下解决了它!

How to know information about the clicked bar in highchart column r shiny plot

希望这对其他人有帮助!

library (shiny)
library (shinydashboard)
library (dplyr)
library (tibble)
library (highcharter)
library(shinyjs)
library (DT)

rm(list=ls())
header <- dashboardHeader()
sidebar <- dashboardSidebar()

body <- dashboardBody(
fluidRow(
box(
tags$head(tags$style(HTML("#OnTime{height:20vh !important;} "))),
title = "On Time", status = "primary", solidHeader = TRUE, width = 6,
highchartOutput("OnTime")
)
),
fluidRow(
box(
title = "WIP Table", status = "primary", solidHeader = TRUE,
DT::dataTableOutput("Table")
)
),
fluidRow(
box(
textOutput("text")
)
)
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {

Customer <- c("England", "France", "US", "Canada", "England", "France", "US", "Canada", "England")
OnTime <- c("On Time", "On Time", "Overdue", "On Time", "Overdue", "On Time", "Overdue","On Time", "On Time")
Gate <- c(1,2,3,2,3,2,1,2,3)
Quantity <- c(1,1,1,1,1,1,1,1,1)

data <- data.frame(Customer,OnTime,Gate, Quantity)

output$OnTime <- renderHighchart({

Lvl1GroupingStatus <- aggregate(data$Quantity, by = list(data$OnTime),FUN=sum)
Lvl1dfStatus <- data_frame(name = Lvl1GroupingStatus$Group.1,y = Lvl1GroupingStatus$x,drilldown = tolower(name))

Lvl2WIPOverDue <- data[data$OnTime == "Overdue",]
Lvl2WIPOverDueb <- aggregate(Lvl2WIPOverDue$Quantity, by = list(Lvl2WIPOverDue$Customer),FUN=sum)
Lvl2dfWIPOverDue <- arrange(data_frame(name = Lvl2WIPOverDueb$Group.1,value = Lvl2WIPOverDueb$x),desc(value))

Lvl2WIPOnTime <- data[data$OnTime == "On Time",]
Lvl2WIPOnTimeb <- aggregate(Lvl2WIPOnTime$Quantity, by = list(Lvl2WIPOnTime$Customer),FUN=sum)
Lvl2dfWIPOnTime <- arrange(data_frame(name = Lvl2WIPOnTimeb$Group.1,value = Lvl2WIPOnTimeb$x),desc(value))

ClickFunction <- JS("function(event) {Shiny.onInputChange('Clicked', event.point.name);}")

highchart() %>%
hc_chart(type = "column") %>%
hc_xAxis(type = "category") %>%
hc_legend(enabled = FALSE) %>%
hc_yAxis(gridLineWidth = 0) %>%
hc_plotOptions(series = list(column = list(stacking = "normal"),
borderWidth=0,
dataLabels = list(enabled = TRUE),
events = list(click = ClickFunction)
)
) %>%
hc_add_series(data=Lvl1dfStatus,name="Status", colorByPoint = TRUE,colors = c("#003395","#D20000")) %>%

hc_drilldown(
allowPointDrilldown = TRUE,
series = list(
list(id = "overdue", data = list_parse2(Lvl2dfWIPOverDue), name="Customer"),
list(id = "on time", data = list_parse2(Lvl2dfWIPOnTime), name="Customer")

)
)
})

makeReactiveBinding("outputText")

observeEvent(input$Clicked, {
outputText <<- paste0(input$Clicked)
})

output$text <- renderText({
outputText
})

output$Table <- DT::renderDataTable({

temp <- data
rowcheck <- temp[temp$OnTime == input$Clicked,]

if (nrow(rowcheck)!=0) {
temp <- temp[temp$OnTime == input$Clicked,]
Lvl1Click <<- input$Clicked
}
else {
temp <- temp[temp$OnTime == Lvl1Click,]
temp <- temp[temp$Customer == input$Clicked,]
}

return (temp)

})
}

#Combines Dasboard and Data together
shinyApp(ui, server)

关于shinydashboard - Highcharter - 单击事件以从图表中过滤数据,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/48887731/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com