I'm making a leaflet map with popups. The popups give information of the ID of the polygon being selected. The problem I have is that the name of the field use for ID can change, so the way I was originally doing doesn't work anymore.
Here is a reproducible example:
## preparing the RE:
library(maps); library(sf); library(leaflet); library(htmltools)
w = st_as_sf(map('world', plot = FALSE, fill = TRUE))
What I use to do is prepare a html string to display:
text <- paste0("<b>ID %s</b>")
Then call the leaflet and populating the popups with sprintf and htmlEscape
leaflet(data=w) %>% addTiles() %>%
addPolygons(
popup = ~sprintf(
text,
htmlEscape(ID)
)
)
This works great :
However, the field isn't always called ID, but the name is known and in a r object (here called vari):
colnames(w) <- c("geometry", "country")
vari <- "country"
text <- paste0("<b>", vari, " %s</b>")
leaflet(data=w) %>% addTiles() %>%
addPolygons(
popup = ~sprintf(
text,
htmlEscape(vari)
)
)
This doesn't work:
I've tried using as.name so it would be considered as a symbol but it doesn't work:
vari <- as.name("country")
text <- paste0("<b>", vari, " %s</b>")
leaflet(data=w) %>% addTiles() %>%
addPolygons(
popup = ~sprintf(
text,
htmlEscape(vari)
)
)
Error in sprintf(text, htmlEscape(vari)) :
invalid type of argument[1]: 'symbol'
Any idea how to fix that? BTW, my HTML is more complex than in my example (uses more variables, however, all other variable names are fixed, only the ID field change).
I'm not sure if this is what you're after, but it sounds like you want to be able to simply populate any popup with the data from a column that doesn't necessarily have the name ID, but is simply an identifier agnostic of title? So in this case country? I fear this is an ugly cheat, but given your data structure contains a data.frame where the coords are actually a list structure, i simply test the dataframe columns for class, whichever is a character, use that as the index and directly call
leaflet(data=w) %>% addTiles() %>%
addPolygons(
popup = ~sprintf('<b>ID %s</b>', w[[names(which(mapply(is.character, w)))]])
)
Related
There is an extension for "datatables" in R called "Responsive". It adds the "green plus" button on the left side of the row. By clicking on it we can get the view with "hidden" columns.
Here is an example. The "visible" column "mpg_percents_visible" has correct format (3%) when
"hidden" column "mpg_percents_hidden" has incorrect formatting in extended view (0.0326644890340644).
library(DT)
# 1. Data set
df_mtcars <- mtcars %>%
mutate(
mpg_percents_visible = mpg / sum(mpg),
mpg_percents_hidden = mpg / sum(mpg)) %>%
select(mpg_percents_visible, everything())
# 2. Datatable
datatable(df_mtcars, extensions = c('Responsive')) %>%
formatPercentage(c('mpg_percents_visible', 'mpg_percents_hidden'))
How show hidden column "mpg_percents_hidden" in a correct format (3%)?
Thanks!
The formatPercentage function overwrites the cells data with the help of the rowCallback option of Datatables, and this has no effect on the hidden columns. The thing to do is to make the change in the render function of the columnDefs option (so you have to write the formatting in JavaScript).
library(dplyr)
library(DT)
df_mtcars <- mtcars %>%
mutate(
mpg_percents_visible = mpg / sum(mpg),
mpg_percents_hidden = mpg / sum(mpg)) %>%
select(mpg_percents_visible, everything())
render <- c(
'function(data, type, row, meta){',
' if(type === "display"){',
' return (100*parseFloat(data)).toFixed(0) + "%";',
' }else{',
' return data;',
' }',
'}'
)
datatable(
df_mtcars,
extensions = c('Buttons', 'Responsive'),
options = list(
responsive = TRUE,
columnDefs = list(
list(targets = 13, render = JS(render))
)
)) %>%
formatPercentage('mpg_percents_visible')
I learnt that here. Note that:
The only potential gotcha with this would be if something changes -
columns.render is only called once and then cached, whereas that
calculation in rowCallback is called on each draw. If the data is
static, then what I suggested would be fine.
I would like to be able to cross-reference a table or figure in a word document using the officer R package.
I have come across these materials so far but they do not seem to have a solution:
https://davidgohel.github.io/officer/articles/word.html#table-and-image-captions
and a similar question
add caption to flextable in docx
In both of these I can only insert a caption as a level 2 header and not a true table caption.
What I want to be able to do in Word is Insert -> Cross-reference and go to Reference type: Table and see my caption there. Right now I can only see the caption under Numbered item.
Does this functionality exist in officer or anywhere else?
In word, the table numbers use the { SEQ \\# arabic } pattern, but references to them use { REF bookmark \h }. We can use this to make new code which can reference a SEQ field.
code:
ft <- regulartable(head(iris)) # create flextable
str <- paste0(' REF ft \\h ') # create string to be used as reference to future bookmark
doc <- read_docx() %>%
body_add_par('This is my caption' , style = 'Normal') %>% # add caption
slip_in_seqfield(str = "SEQ Table \\# arabic",
style = 'Default Paragraph Font',
pos = "before") %>% # add number for table
body_bookmark('ft') %>% # add bookmark on the number
slip_in_text("Table ",
style = 'Default Paragraph Font',
pos = "before") %>% # add the word 'table'
body_add_flextable(value = ft, align = 'left') %>% # add flextable
body_add_break() %>% # insert a break (optional)
slip_in_text('As you can see in Table',
style = 'Default Paragraph Font',
pos = 'after') %>% # add the text you want before the table reference
slip_in_seqfield(str = str,
style = 'Default Paragraph Font',
pos = 'after') %>% # add the reference to the table you just added
slip_in_text(', there are a lot of iris flowers.',
style = 'Default Paragraph Font',
pos = 'after') %>% # add the rest of the text
print('Iris_test.docx') # print
Hope this helps :)
Just for the record, you can do this a bit easier now by using some helper functions from the {crosstable} package.
Disclaimer: I am the developer of that package and these functions were highly inspired by #morgan121's answer. Thanks Morgan!
Here is an example:
library(officer)
library(crosstable)
library(ggplot2)
options(crosstable_units="cm")
ft = regulartable(head(iris))
my_plot = ggplot(data = iris ) +
geom_point(mapping = aes(Sepal.Length, Petal.Length))
doc = read_docx() %>%
body_add_title("Dataset iris", 1) %>%
body_add_normal("Table \\#ref(table_iris) displays the 6 first rows of the iris dataset.") %>%
body_add_flextable(ft) %>%
body_add_table_legend("Iris head", bookmark="table_iris") %>%
body_add_normal("Let's add a figure as well. You can see in Figure \\#ref(fig_iris) that sepal length is somehow correlated with petal length.") %>%
body_add_figure_legend("Relation between Petal length and Sepal length", bookmark="fig_iris") %>%
body_add_gg2(my_plot, w=14, h=10, scale=1.5)
print(doc , 'Iris_test.docx')
More info on https://danchaltiel.github.io/crosstable/articles/crosstable-report.html.
As with morgan121's code, you have to select all the text in MS Word and press F9 twice for the numbers to update properly.
I have a leaflet map which I created in R and I would like to add a dropdown filter based on fields in a column. The code looks straightforward in JS, see example here Leaflet dropdown filter, however I can't figure out how to adjust the code for R.
library(leaflet.extras)
n = c(2, 3, 5)
long = c(102.1,102.13,102.2)
lat = c(55,55.1,55.15)
select_cols= c("a","b","c")
df = data.frame(n, long, lat,select_cols)
pal <- colorFactor(c("navy", "red","green"), domain = c("a","b","c"))
leaflet(df)%>% addTiles()%>%
addCircleMarkers(lng = long,lat=lat,radius= ~n*2,
color=~pal(select_cols),stroke=F,fillOpacity = 1)
Here is the JS code that adds a dropdown filter.
var legend = L.control({position: 'topright'});
legend.onAdd = function (map) {
var div = L.DomUtil.create('div', 'info legend');
div.innerHTML = '<select><option>1</option><option>2</option>
<option>3</option></select>';
div.firstChild.onmousedown = div.firstChild.ondblclick =
L.DomEvent.stopPropagation;
return div;
};
legend.addTo(map);
I know how to add the "show hide layers" feature, however I have over 20 different fields and I think it would be easier if the user could select the associated field using a drop down box.
In case anyone is looking for something similar, I found a solution using crosstalk. See the code below for an example.
library(crosstalk)
library(tidyverse)
library(leaflet.extras)
quakes <- quakes %>%
dplyr::mutate(mag.level = cut(mag,c(3,4,5,6),
labels = c('3.01-4.00', '4.01-5.00', '5.01-6.00')))
quakes_sd<- SharedData$new(quakes)
map<- leaflet(quakes_sd)%>%addProviderTiles(providers$Esri.WorldTopoMap)%>% addCircles()
#add filter
bscols(
filter_select("Magnitude Level", "Magnitude Level", quakes_sd, ~mag.level)
)
bscols(map)
I am trying to get finer control of leaflet popups in R, using the leaflet package. The code for a MWE is below:
library(dplyr)
library(magrittr)
library(leaflet)
download.file(
url = "http://biogeo.ucdavis.edu/data/gadm2.8/rds/GBR_adm1.rds",
destfile = "GBR_adm1.rds",
method = "curl"
)
shp_gbr <- readRDS("GBR_adm1.rds")
# get centroids for placing popups in second map
shp_gbr_centers <-
rgeos::gCentroid(shp_gbr, byid = TRUE) %>%
sp::SpatialPointsDataFrame(shp_gbr#data, match.ID = FALSE)
shp_gbr#data %<>%
left_join(shp_gbr_centers[1], by = 'OBJECTID', copy = TRUE) %>%
rename(lat = y, lng = x) %>%
select(NAME_1, lat, lng) %>%
mutate(text = ProgGUIinR::LoremIpsum)
popup <- paste("<b><h3>", shp_gbr$NAME_1, "</h3></b>", shp_gbr$text)
shp_gbr %>%
leaflet() %>%
addPolygons(popup = ~popup)
This gives a nice map with popups that appear on clicking within the areas of the 4 countries, but in this case, the text is too much for the popup to handle nicely:
What I would like is to access some of the popupOptions available via the addPopups function, in this case to make the popup wider and have a scroll bar. An example of this is below:
shp_gbr %>%
leaflet() %>%
addPolygons() %>%
addPopups(
data = shp_gbr#data,
popup = ~popup,
options =
popupOptions(
maxWidth = 600,
maxHeight = 100
)
)
However, the popups are now set to be open on launch, rather than appearing on clicking within the boundaries, and do not reopen on click once closed:
My question is how to combine these elements so that you could have, say, a scroll bar for too much text within a map such as the first example, where the popups are closed by default but open on click.
You could use this function to create your popup:
popup <- paste("<div class='leaflet-popup-scrolled' style='max-width:600px;max-height:100px'><b><h3>", shp_gbr$NAME_1, "</h3></b>", shp_gbr$text,"</div>")
It wraps the popup in a div with the leaflet-popup-scrolled class to add the scroll bar and inline CSS to set the max-width and max-height.
I would like to control the width of a leaflet-feature popup via R, how can I do that?
output$HomeMap <- renderLeaflet(leaflet() %>%
addTiles() %>%
setView(1.93, 41.48, zoom = 3) %>%
addPolygons(data = subset(world, name %in% datasourceInput()),
color = datasourceColor(),
weight = 1,
popup = datasourcePopups()
))
I do not understand how to control the options associated to the popup..
Many thanks in advance for your help on this issue and best regards!
I had a similar issue in creating the series of maps that I am working on right now. Any formatting that I would want to be done on the html/css/javascripted page, is made inside quotations, I used double quotes example: "<br>" to create a line break and start the next piece of information on the next line.
To give order to it, I used a set of tables...I had 16 rows with text and wanted to use the last row for a png image. It worked, but the image made the text scale off the side of the popup above...the background did not scale with it.
So I did some playing around with the code, scoured the net, and then inserted this line of code at the very top of my popup variable:
myPopUp<- paste("<style> div.leaflet-popup-content {width:auto !important;}</style>",
myvariable, "some copy to print", another variable)
Making sure the entire popup is inside of the paste function and now the popup automatically adjusts to the size of the content. This does mean that you need to pay attention to your copy length and appropriately size any images in your popups.
I have mine set up to pull 16 values and a graph from one of 292 census tracts and drop in the right data and cached images, then re-scale and it is working flawlessly. You might want to give it a try.
this is the magic code: "<style> div.leaflet-popup-content {width:auto !important;}</style>"
This is how it looks
Now if only I could make the popup anchor somewhere that I approved of consistently!
#bethanyP's answer will work in all cases. I thought some additional detail might be helpful. I commented inline to explain each step.
library(leaflet)
# example from https://rstudio.github.io/leaflet/popups.html
content <- paste(sep = "<br/>",
"<b><a href='http://www.samurainoodle.com'>Samurai Noodle</a></b>",
"606 5th Ave. S",
"Seattle, WA 98138"
)
leaflet() %>% addTiles() %>%
addPopups(-122.327298, 47.597131, content,
options = popupOptions(closeButton = FALSE)
)
# according to ?popupOptions can specify min/maxWidth
# set min and max width the to force a width
leaflet() %>% addTiles() %>%
addPopups(
-122.327298, 47.597131,
content,
options = popupOptions(
closeButton = FALSE,
minWidth = 300,
maxWidth = 300
)
)
# on the other hand, it appears that we only have maxHeight
# so height cannot be controlled in the same way
leaflet() %>% addTiles() %>%
addPopups(
-122.327298, 47.597131,
content,
options = popupOptions(
closeButton = FALSE,
maxHeight = 20
)
)
# let's extend the example to show how we can use
# htmltools to add CSS to control our popups
# could also use the approach suggested in
# the other answer, but I think this is more
# fitting with typical HTML/JS convention
lf <- leaflet() %>% addTiles() %>%
addPopups(
-122.327298, 47.597131,
content,
options = popupOptions(
closeButton = FALSE,
# not necessary but adding a className
# can help in terms of specificity
# especially if you have multiple popups
# with different styling
className = "myspecial-popup"
)
)
library(htmltools)
browsable(
tagList(
tags$head(
# more specific is better
tags$style(
'div.myspecial-popup div.leaflet-popup-content-wrapper {
height: 400px;
opacity: .5;
}'
)
),
lf
)
)