why when Im using modules the clickable feature in my highchart treemap is not working.
I tried this without module and worked well.
Probably is something related no namespace, right , but I can not find what it it.
Any help ?
This is my code:
library(shiny)
library(highcharter)
library(gapminder)
library(shinyjs)
source(file = 'module_ex_2.R')
ui <- fluidPage(
mod_ex2_UI('ex1')
)
server <- function(input, output){
mod_ex2_Server('ex1')
}
shinyApp(ui, server)
My module file:
mod_ex2_UI <- function(id) {
ns <- NS(id)
tagList(
highchartOutput(ns("hcontainer")),
htmlOutput(ns("clicked"))
)
}
mod_ex2_Server <- function(id) {
moduleServer(
id,
function(input, output, session) {
click_js <- JS("function(event) {Shiny.onInputChange('treemapclick', event.point.name);}")
output$hcontainer <- renderHighchart({
gapminder::gapminder %>%
dplyr::filter(year == 2007) %>%
highcharter::data_to_hierarchical(group_vars = c(continent, country), size_var = pop) %>%
hchart(type = "treemap") %>%
hc_plotOptions(treemap = list(events = list(click = click_js)))
})
output$clicked <- renderUI({
if(is.null(input$treemapclick)){
reactable::reactable(data =gapminder::gapminder %>%
dplyr::filter(year == 2007) %>%
dplyr::filter(country == 'China'))
}else{
reactable::reactable(data =gapminder::gapminder %>%
dplyr::filter(year == 2007) %>%
dplyr::filter(country == input$treemapclick))
}
})
}
)
}
Thanks any help would be amazing.
You need to append the namespace to your custom event like so:
click_js <- JS(
glue::glue("function(event) {{
Shiny.setInputValue('{NS(id)('treemapclick')}',
event.point.name);
}}"
)
)
N.B. onInputChange is the older name for setInputValue and the latter is more verbose (cf. to this Shiny article)
Related
I'm using this plugin to enable manual column resizing for the DataTables in R Shiny. Now I would like to save the column width state after the user resized the table. For this I would like to communicate the change into a Shiny input variable. However I am quite new to Javascript and jQuery which means I don't understand the instructions on the Github page. So I would like to ask how to achieve this.
library(shiny)
library(DT)
library(htmltools)
dep <- htmlDependency(
name = "colResize",
version = "1.6.1",
src = normalizePath("colResize"),
script = "jquery.dataTables.colResize.js",
stylesheet = "jquery.dataTables.colResize.css",
all_files = FALSE
)
js <- c(
"function(column, columns){",
" Shiny.setInputValue('colwidth', column);",
"}"
)
dat <- head(iris, 6)
ui <- fluidPage(
br(),
fluidRow(
column(
width = 8,
DTOutput("dtable")
),
column(
width = 4,
verbatimTextOutput("columnWidth")
)
)
)
server <- function(input, output, session){
output[["dtable"]] <- renderDT({
dtable <- datatable(
dat,
options = list(
colResize = list(
onResizeEnd = JS(js)
)
)
)
deps <- dtable[["dependencies"]]
deps <- c(deps, list(dep))
dtable[["dependencies"]] <- deps
dtable
})
output[["columnWidth"]] <- renderPrint({
input[["colwidth"]]
})
}
shinyApp(ui, server)
I am building and app, that includes geolocation captures using the geoloc package
This is an example app:
library(shiny)
library(leaflet)
library(geoloc)
ui <- fluidPage(
h2("Where Am I?"),
tags$p("Click the button to get your location"),
geoloc::button_geoloc("myBtn", "Get my Location"),
tags$br(),
textOutput("coords"),
textOutput("col"),
leafletOutput("lf")
)
server <- function(input, output) {
output$coords <- renderText(paste(input$myBtn_lat, input$myBtn_lon, sep = ", "))
Lats <- reactiveValues(Lat = NULL)
observeEvent(input$myBtn_lat, {
Lats$Lat <- append(Lats$Lat, input$myBtn_lat)
})
output$col <- renderText({
Lats$Lat
})
output$lf <- renderLeaflet({
req(input$myBtn_lon)
req(input$myBtn_lat)
leaflet() %>%
addTiles() %>%
setView(as.numeric(input$myBtn_lon), as.numeric(input$myBtn_lat), zoom = 17) %>%
addMarkers(as.numeric(input$myBtn_lon), as.numeric(input$myBtn_lat), label = "You're here!")
})
}
shinyApp(ui, server)
I have two questions for this:
How to get a vector of latitudes and longitudes with the button
I need this because usually, we like to take 4 or 5 times the location and then use the median.
This has been addressed in this question, however, there are some kinks I can't figure out since the button is a custom one, and the inputs are not input$myBtn, but input$myBtn_lat and input$myBtn_lon, I find it hard to compute. This is what I am trying to do with the observe events
How to transform this into shiny modules
This will go to a larger shiny app, so I would love to generate modules for this, but again, the facto that the input in ui is "myBtn", but then in the server I have 2 inputs (MyBtn_lon and MyBtn_lat), make it very hard to figure out
Any help is welcome
How about the following code with Shiny modules? I tested and it worked.
library(shiny)
library(leaflet)
library(geoloc)
mapUI <- function(id, label = "Location in map"){
ns <- NS(id)
tagList(
geoloc::button_geoloc(ns("myBtn"), "Get my Location"),
tags$br(),
textOutput(ns("coords")),
textOutput(ns("col")),
textOutput(ns("md")), # for median latitude
leafletOutput(ns("lf"))
)
}
mapServer <- function(id){
moduleServer(
id,
function(input, output, session){
output$coords <- renderText(paste(input$myBtn_lat, input$myBtn_lon, sep = ", "))
Lats <- reactiveValues(Lat = NULL)
observeEvent(input$myBtn, {
Lats$Lat <- c(Lats$Lat, input$myBtn_lat)
})
output$col <- renderText({
Lats$Lat
})
# add median latitude
output$md <- renderText({
req(input$myBtn_lat)
if(length(Lats$Lat) %% 5 == 0){
paste0("Median latitute is: ", median(Lats$Lat))
}
})
output$lf <- renderLeaflet({
req(input$myBtn_lon)
req(input$myBtn_lat)
leaflet() %>%
addTiles() %>%
setView(as.numeric(input$myBtn_lon), as.numeric(input$myBtn_lat), zoom = 17) %>%
addMarkers(as.numeric(input$myBtn_lon), as.numeric(input$myBtn_lat), label = "You're here!")
})
}
)
}
ui <- fluidPage(
h2("Where Am I?"),
tags$p("Click the button to get your location"),
mapUI("map1")
)
server <- function(input, output, session) {
mapServer("map1")
}
shinyApp(ui, server)
You should click "myBtn", not "myBtn_lat". So try change observeEvent(input$myBtn_lat to observeEvent(input$myBtn.
In addition, what is the purpose to take 4 or 5 times the location? The coordinates do not change or change very little every time you click the button.
Based on the answer to this question: Highcharter - Clickable Pie Chart - How to get the category name from the slice clicked on a Pie Chart in Shiny?, I am trying to capture the output of a click event on a highcharter treemap in an R Shiny app.
I think I just need the right name to replace "event.point.name" in this javascript function:
function(event) {Shiny.onInputChange('treemapclick', event.point.name);}
but I am not sure where to look.
Thanks in advance for your generosity!
library(shiny)
library(highcharter)
library(gapminder)
ui <- fluidPage(
column(12, highchartOutput("hcontainer",height = "300px")),
column(12, textOutput("clicked")))
server <- function(input, output){
click_js <- JS("function(event) {Shiny.onInputChange('treemapclick', event.point.name);}")
output$hcontainer <- renderHighchart({
gapminder::gapminder %>%
filter(year == 2007) %>%
highcharter::data_to_hierarchical(group_vars = c(continent, country), size_var = pop) %>%
hchart(type = "treemap") %>%
hc_plotOptions(events = list(click = click_js))
})
output$clicked <- renderText({
input$treemapclick
})
}
shinyApp(ui, server)
Figured out the problem! The issue was not with the event.point.name variable, but with the plot options. Changing it to this:
hc_plotOptions(treemap = list(events = list(click = click_js)))
does the trick.
Working reprex:
library(shiny)
library(highcharter)
library(gapminder)
ui <- fluidPage(
column(12, highchartOutput("hcontainer",height = "300px")),
column(12, textOutput("clicked")))
server <- function(input, output){
click_js <- JS("function(event) {Shiny.onInputChange('treemapclick', event.point.name);}")
output$hcontainer <- renderHighchart({
gapminder::gapminder %>%
filter(year == 2007) %>%
highcharter::data_to_hierarchical(group_vars = c(continent, country), size_var = pop) %>%
hchart(type = "treemap") %>%
hc_plotOptions(treemap = list(events = list(click = click_js)))
})
output$clicked <- renderText({input$treemapclick })
}
shinyApp(ui, server)
I'm currently trying to use a googlelayer as a base layer for a leaflet map in shiny R, that's why I've been using shinyJs in order to insert a Js script into my R code in order to insert a map, the thing is that I don't manage to access the map outside of the Javascript code, and if I look up to the Js console, it says that "the map container has already been initialized". I provide you the code of the app as a reproducible science.
###################
#### Library ######
###################
library(leaflet)
library(shiny)
library(shinythemes)
library(shinyjs)
#library(raster)
###################
setwd("D:\\R")
ui <- fluidPage(
tags$head(
tags$link(rel="stylesheet", href="https://unpkg.com/leaflet#1.0.3/dist/leaflet.css"),
tags$script(src="shared/shiny.js"),
tags$script(src="https://maps.googleapis.com/maps/api/js?key=AIzaSyAQvaBc5_RruTllCvOxy3i9YNFYlaDzaJ8"),
tags$script(src="https://unpkg.com/leaflet#1.0.3/dist/leaflet.js"),
tags$script(src='https://unpkg.com/leaflet.gridlayer.googlemutant#latest/Leaflet.GoogleMutant.js')
),
sidebarLayout(
sidebarPanel(
actionButton(inputId = "button",
label = "coucou")
),
mainPanel(
leafletOutput("mymap")
)
#)
),
tags$script(HTML('$(document).on("shiny:connected", function(){
var mymap = L.map("mymap").setView([45.777222,3.087025],4);
var roads = L.gridLayer.googleMutant({type : "satellite"}).addTo(mymap);
var el = document.getElementById(mymap.id);
Shiny.onInputChange("mymap",el);
})'))
)
server <- function(input, output) {
# output$mymap <- renderLeaflet({
# leaflet() %>%
# setView(-1.252441, 47.802332, 4)
# })
# jean <- reactive(input$el)
#print(output$mymap)
observeEvent(input$button, {
output$mymap <- renderLeaflet({
leafletProxy("mymap", data =input$mymap) %>%
addMarkers(45.777222,
3.087025,
"btn")
})
})
observeEvent(input$mymap_click, {
cat("vroum")
})
}
shinyApp(ui = ui, server = server)
You can plot a Google Map directly using my googleway package
library(shiny)
library(googleway)
ui <- fluidPage(
google_mapOutput(outputId = "map", height = 600)
)
server <- function(input, output){
output$map <- renderGoogle_map({
google_map(key = 'your_api_key')
})
observeEvent(input$map_map_click, {
print(input$map_map_click)
})
}
shinyApp(ui, server)
To answer your question, you can access the map using the following code:
var el = document.getElementById("mymap");
var map = $(el).data("leaflet-map"));
But this doesn't get you to add the google layer as you need leaflet version 1.0.3 and the R package uses version 0.7 and you can't just load the version 1.0.3 as you did because it will raise come compatibility issues with the R package.
I'm trying to do the same but I found nothing so far. If you managed to do it, I would be very happy to know how.
I would like to format number (add big.mark) in tooltip in googleVis chart. Yesterday I asked this quesion: Hover style of label in googleVis and got the answer. Today, I've got quite simillar problem - the difference is that there are more than one group, so adding tooltip does not work...
The visualisation of my problem:
And my code:
ui.R:
library("shiny")
library("googleVis")
shinyUI(fluidPage(
htmlOutput("wyk")
))
and server.R:
library("shiny")
library("googleVis")
library("dplyr")
shinyServer(function(input, output) {
d <- iris %>%
group_by(Species) %>%
summarise(ile=1e6*sum(Sepal.Length),
ile2=1e6*sum(Petal.Length))
output$wyk <- renderGvis({
gvisBarChart(d, xvar = "Species", yvar = c("ile", "ile2"),
options=list(legend="top", bar="{groupWidth:'90%'}", height=500))
})
})
I'd be gratfull for any help!
You can do this using roles, here's an example:
library("shiny")
library("googleVis")
d <- iris %>%
group_by(Species) %>%
summarise(ile=1e6*sum(Sepal.Length),
ile2=1e6*sum(Petal.Length))
d$ile.html.tooltip <- prettyNum(d$ile,big.mark = ",",scientific = F)
d$ile2.html.tooltip <- prettyNum(d$ile2,big.mark = ",",scientific = F)
ggvis_plot <- gvisBarChart(d, xvar = "Species", yvar = c("ile","ile.html.tooltip","ile2","ile2.html.tooltip"),
options=list(legend="top", bar="{groupWidth:'90%'}", height=500))
plot(ggvis_plot)