I am trying to run the code below on two R versions, and do not have the same display. I want to display one value ('10') with one category only ('Feb') and this is not working for one of the versions, here you can see the output comparison:
And here is the code :
library("shiny")
library("highcharter")
data(citytemp)
ui <- fluidPage(
h1("Highcharter EXAMPLE"),
fluidRow(
column(width = 8,
highchartOutput("hcontainer",height = "500px")
),
selectInput("option", label = "", width = "100%",
choices = c("Tokyo", "NY"))
)
)
server <- function(input, output) {
data <- citytemp[,c("month","tokyo","new_york")]
data = data[data$month%in%c("Dec","Jan","Feb","Mar"),]
choose_Option <- reactive({
sort_option <- input$option
if(sort_option=="Tokyo"){
data = data[order(data$tokyo),]
}
else{
data = data[order(data$new_york),]
}
return(data)
})
output$hcontainer <- renderHighchart({
data = choose_Option()
data = data[data$month=="Feb",]
chart <- highchart() %>%
hc_chart(type = "bar") %>%
hc_title(text = "Monthly Average Temperature for main cities") %>%
hc_subtitle(text = "Source: WorldClimate.com") %>%
hc_xAxis(categories = data$month) %>%
hc_yAxis(title = list(text = "Temperature (C)"),stackLabels=list(enabled=FALSE))%>%
hc_plotOptions(
series=list(stacking="normal"))
hc <- chart %>% hc_add_series(yAxis=0,name="Tokyo",data = 10,colorByPoint=TRUE,dataLabels = list(enabled = TRUE) )
return(hc)
})
}
shinyApp(ui = ui, server = server)
Do you have any suggestions about how I could correct my display in the version 3.2.0 ? Thank you, best regards, Madzia
Related
In the relatively simple shiny application below I select a point on load. Once the user chooses a new number in the selector I'd like highcharter to select that point instead. In other words, if the user selects 1 then then it should select the 1st point.
Suggestions for how to do this?
library(shiny)
library(highcharter)
ui <- function(){
div(
selectInput('id', label = 'select', choices = 1:3, selected = 2),
highchartOutput("plot")
)
}
server <- function(session, input, output){
output$plot <- renderHighchart({
hc <- highchart() %>%
hc_chart(events = list(load = JS("function(){this.series[0].points[2].select()}"))) %>%
hc_add_series(data.frame(x = 1:3, y = 1:3), "scatter", hcaes(x, y)) %>%
hc_plotOptions(
allowPointSelect = TRUE
)
hc
})
observeEvent(input$id, {
# Here I'd like to send a message to the highchart
# to select the chosen point
})
}
shinyApp(ui, server)
This can be done using hcpxy_update_point function in the development version of {highcharter} (remotes::install_github("jbkunst/highcharter")).
Be sure to use the correct id for the chart which in this case is plot.
More examples in https://jbkunst.shinyapps.io/02-proxy-functions/.
library(shiny)
library(highcharter)
ui <- function(){
div(
selectInput('id', label = 'select', choices = 1:3, selected = 2),
highchartOutput("plot")
)
}
server <- function(session, input, output){
output$plot <- renderHighchart({
hc <- highchart() %>%
hc_chart(events = list(load = JS("function(){this.series[0].points[2].select()}"))) %>%
hc_add_series(
data.frame(x = 1:3, y = 1:3),
"scatter",
hcaes(x, y),
id = "someid",
) %>%
hc_plotOptions(
allowPointSelect = TRUE
)
hc
})
observeEvent(input$id, {
id_0_based <- as.numeric(input$id) - 1
highchartProxy("plot") %>%
# set all points unselected `selected = FALSE`
hcpxy_update_point(id = "someid", 0:2, selected = FALSE) %>%
# then set to selected the _selected_ point
hcpxy_update_point(
id = "someid",
id_point = id_0_based,
selected = TRUE
)
})
}
shinyApp(ui, server)
How can I make a highcharter time series graph inside a box in shiny? I'm trying to make a chart like this one in shiny. Does anyone know how?
Website: http://www.piaschile.cl/mercado/benchmarking-internacional/
You could start with the sample shiny app
library("shiny")
library("highcharter")
data(citytemp)
ui <- fluidPage(
h1("Highcharter Demo"),
fluidRow(
column(width = 4, class = "panel",
selectInput("type", label = "Type", width = "100%",
choices = c("line", "column", "bar", "spline")),
selectInput("stacked", label = "Stacked", width = "100%",
choices = c(FALSE, "normal", "percent")),
selectInput("theme", label = "Theme", width = "100%",
choices = c(FALSE, "fivethirtyeight", "economist",
"darkunica", "gridlight", "sandsignika",
"null", "handdrwran", "chalk")
)
),
column(width = 8,
highchartOutput("hcontainer",height = "500px")
)
)
)
server = function(input, output) {
output$hcontainer <- renderHighchart({
hc <- hc_demo() %>%
hc_rm_series("Berlin") %>%
hc_chart(type = input$type)
if (input$stacked != FALSE) {
hc <- hc %>%
hc_plotOptions(series = list(stacking = input$stacked))
}
if (input$theme != FALSE) {
theme <- switch(input$theme,
null = hc_theme_null(),
darkunica = hc_theme_darkunica(),
gridlight = hc_theme_gridlight(),
sandsignika = hc_theme_sandsignika(),
fivethirtyeight = hc_theme_538(),
economist = hc_theme_economist(),
chalk = hc_theme_chalk(),
handdrwran = hc_theme_handdrawn()
)
hc <- hc %>% hc_add_theme(theme)
}
hc
})
}
shinyApp(ui = ui, server = server)
You could also refer to the following links to get started with :
https://datascienceplus.com/making-a-shiny-dashboard-using-highcharter-analyzing-inflation-rates/
http://jkunst.com/highcharter/shiny.html
I have a set of charts and several tables on a Shiny pages. What would be the best way to create a download button to allow user download all of them to one file (i.e pdf). I tried grid.arrange but I am not sure how to convert the highchart objects to grobs objects.
Samples of outputs are below:
library("shiny")
library("highcharter")
data(citytemp)
ui <- fluidPage(
fluidRow(
column(width = 8,
highchartOutput("hcontainer1",height = "500px")),
column(width = 8,
highchartOutput("hcontainer2",height = "500px")),
column(width = 8,
highchartOutput("hcontainer3",height = "500px")),
column(width = 12,dataTableOutput("table"))
)
)
server = function(input, output) {
output$hcontainer1 <- renderHighchart({
hc <- highcharts_demo() %>%
hc_rm_series("Berlin") %>%
hc_chart(type = "line")
hc
})
output$hcontainer2 <- renderHighchart({
hc <- highcharts_demo() %>%
hc_rm_series("Berlin") %>%
hc_chart(type = "bar")
hc
})
output$hcontainer3 <- renderHighchart({
hc <- highcharts_demo() %>%
hc_rm_series("Berlin") %>%
hc_chart(type = "column")
hc
})
output$table <- renderDataTable({
dt <- data.frame(iris[1:10,])
dt
})
}
shinyApp(ui = ui, server = server)
Just try putting a download button at each column. I am unable to install highcharter now so I didn't fully test the code. Let me know if you are having issues -
column(width = 8,
highchartOutput("hcontainer1",height = "500px"), downloadButton("downloadplot1", label = "Download"))
Write a separate function for generating the plot -
gen_plot <- function(series_name, chart_type){
hc <- highcharts_demo() %>%
hc_rm_series(series_name) %>%
hc_chart(type = chart_type)
hc
}
Now in server -
output$downloadplot1 <- downloadHandler(filename ="1.png",
content = function(file) {
png(file, width=800, height=800)
gen_plot("Berlin", "line")
dev.off()
},
contentType = "image/png")
I'm working on a simple line graph in r. for now I can use two selectizeInputs in the UI part to choose a season and a team, each selectizeInput has an ID that is used in the server part in a select statement, anyway I want to adjust the code so that I can select multiple seasons and multiple teams and when that happens I want to plot multiple lines on the graph for each team and season. My question is what should I change in the UI part and what should I change in the server part?
thanks very much for any help!
this is UI part
libraries("plotly","ggplot2","plotrix")
ui <- fluidPage(
fluidRow(
column ( width = 3,
h4(span(tagList(icon("filter")), "Select season")),
selectizeInput('season', "", choices = shots$SeasonNr, selected = TRUE, multiple = TRUE),
br(),
h4(span(tagList(icon("filter")), "Select team")),
selectizeInput('team', "", choices = shots$TeamName, selected = TRUE, multiple = TRUE),
br()
)),
plotlyOutput("pos1")
)
this is my server part
server <- function(input,output, session){
observeEvent(c(input$team), {
team1 <- input$team
Season1 <- input$season
tp <- sqldf(sprintf("select TeamName, Training_ID, SeasonNr, Position, ShotAverage from shots where TeamName is '%s'", team1,"AND SeasonNr is '%s'", Season1))
dfNew<- aggregate(ShotAverage ~ tp$TeamName +tp$Position, data=tp, FUN=mean)
#creates empty dataframe
dfF <- data.frame()
#bind
dfF <- rbind(dfF, dfNew)
colnames(dfF) <- c("Team Name", "Position", "Average")
# render the plot
output$pos1 <-renderPlotly({
plot_ly(x = ~dfF$Position, y = ~dfF$Average, type = 'scatter', mode = 'bar')%>%
layout(title = 'Seasonal team statistics', xaxis = list(title = "Position"),yaxis = list(title = "Average"))
})
})}
shinyApp(ui, server)
untill you have supported us with your data i made an similar example with another dataset from ggplot2
library("plotly","ggplot2","plotrix")
ui <- fluidPage(
fluidRow(
column ( width = 3,
h4(span(tagList(icon("filter")), "Select season")),
selectizeInput('season', "", choices = txhousing$year %>% unique(),selected = TRUE, multiple = TRUE),
br(),
h4(span(tagList(icon("filter")), "Select city")),
selectizeInput('city', "", choices = txhousing$city %>% unique(), selected = TRUE, multiple = TRUE),
br()
)),
plotlyOutput("pos1")
)
server <- function(input,output, session){
dta <- reactive({
req(input$city,input$season)
txhousing %>%
select(city,year,month,median) %>%
filter(city %in% input$city, year %in% input$season) %>%
group_by(city,month) %>%
summarise(median = mean(median))
})
output$pos1 <-renderPlotly({
plot_ly(data = dta(),x = ~month, y = ~median,type = "area",color = ~city) %>%
layout(title = 'Seasonal team statistics', xaxis = list(title = "Month"),yaxis = list(title = "Average"))
})
}
shinyApp(ui, server)
please not that I have separated your code into one reactive and a render statement. This is a better design for shiny then putting everything within an observer statment
Hope this helps!!
I need to be able to add another trace to a plot after a mouse click. I am using R's web framework Shiny to display the plot in a web browser. The series I want to add is dots or any series at this point.
I need to draw lines on the plot also. I want to click a starting point and a ending and a line pass through the clicked points.
This is what I have so far.
#############To Update
#if (!require("devtools"))
#install.packages("devtools")
#devtools::install_github("jbkunst/highcharter")
library("shiny")
library("highcharter")
dots<-hc_add_series_scatter(cars$speed, cars$dist)
hc_base <- highchart() %>%
hc_xAxis(categories = citytemp$month) %>%
hc_add_series(name = "Tokyo", data = citytemp$tokyo)
ui <- fluidPage(
h2("Viewer"),
fluidRow(
h3(""), highchartOutput("hc_1", width = "100%", height = "800px"),
h3("Click"), verbatimTextOutput("hc_1_input2")
)
)
server = function(input, output) {
output$hc_1 <- renderHighchart({
hc_base %>%
hc_add_theme(hc_theme_ffx())%>%
hc_tooltip(backgroundColor="skyblue",crosshairs = TRUE, borderWidth = 5, valueDecimals=2)%>%
hc_add_event_series(series="dots", event = "click")
})
output$hc_1_input2 <- renderPrint({input$hc_1_click })
}
shinyApp(ui = ui, server = server)
Any help would be greatly appreciated.
This could be one way of doing it:
library(shiny)
library(highcharter)
hc_base <- highchart() %>%
hc_xAxis(categories = citytemp$month) %>%
hc_add_series(name = "Tokyo", data = citytemp$tokyo)
ui <- fluidPage(
h2("Viewer"),
fluidRow(
h3(""), highchartOutput("hc_1", width = "100%", height = "800px"),
h3("Click"), verbatimTextOutput("hc_1_input2")
)
)
server = function(input, output) {
output$hc_1 <- renderHighchart({
hc_base %>%
hc_add_theme(hc_theme_ffx())%>%
hc_tooltip(backgroundColor="skyblue",crosshairs = TRUE, borderWidth = 5, valueDecimals=2)%>%
hc_add_event_point(event = "click")
})
observeEvent(input$hc_1_click,{
output$hc_1 <- renderHighchart({
hc_base %>%
hc_add_theme(hc_theme_ffx())%>%
hc_tooltip(backgroundColor="skyblue",crosshairs = TRUE, borderWidth = 5, valueDecimals=2)%>%
hc_add_series_scatter(cars$speed, cars$dist)
})
})
output$hc_1_input2 <- renderPrint({input$hc_1_click })
}
shinyApp(ui = ui, server = server)
Hope it helps!