I have a loop that clips to different features and the ceramic package downloads a basemap for each feature and then the map is printed using the tmap package. In an html or pdf output in Rmarkdown, I can use {r map, results = 'hide', fig.keep='all'} to hide ceramic's "Preparing to download..." messages. The maps print, but the messages don't (exactly what I want). However, using pagedreport, that method doesn't work. No maps print.
I tried wrapping the ceramic part suppressWarnings(suppressMessages(suppressPackageStartupMessages({basemap})))
And setting options(warn=-1) at the beginning of the chunk
Neither work. Any other suggestions?
You'd need your own mapbox API key to run this. The output is ugly, but gets the point across.
Reproducible loop:
---
title: "nc"
date: "`r Sys.Date()`"
output:
pagedreport::paged_windmill:
knit: pagedown::chrome_print
---
```
{r libs, include = F}
library(raster)
library(sp)
library(tidyverse)
library(ceramic)
library(tmap)
library(maps)
```
```
{r individual-maps, echo=FALSE, error=TRUE, message=FALSE, warning=FALSE, results='asis', fig.keep='all'}
#get practice shapefile
nc <- sf::read_sf(system.file("shape/nc.shp", package="sf"))
#get list of unique trail numbers
#unique_county_names <- unique(nc$NAME)
unique_county_names <- c("Ashe", "Alleghany", "Surry") # created a short list for simplicity
#set Mapbox API key for the session
Sys.setenv(MAPBOX_API_KEY = "need your own")
for (i in 1:length(unique_county_names)) {
county <-
filter(nc, NAME == unique_county_names[i])
# set basemap
basemap = ceramic::cc_location(loc =
extent(sf::st_transform(
county, 4326
)),
base_url = "https://api.mapbox.com/styles/v1/mapbox/outdoors-v12/tiles/{zoom}/{x}/{y}")
county_map <- tm_shape(basemap) +
tm_rgb() +
tm_shape(county) +
tm_polygons()
print(county_map)
}
```
I figured out it was a cat() output which then led me to this post How to hide or disable in-function printed message
and the answer by Ben, credited to Hadley Wickham:
quiet <- function(x) {
sink(tempfile())
on.exit(sink())
invisible(force(x))
}
so then I wrapped it around the basemap:
basemap = quiet(ceramic::cc_location(loc =
extent(sf::st_transform(
county, 4326
)),
base_url = "https://api.mapbox.com/styles/v1/mapbox/outdoors-v12/tiles/{zoom}/{x}/{y}"))
No more messages!
Related
I am trying to build in an automated way a Word document that will display a list of Youtube video links I want to watch with Youtube Title video as text and the Youtube url as a hyperlink.
I have used Rmarkdown to do that and it works well with a defined number of urls.
But my issue is that I want that Rmarkdown document to work with any number of urls as input of my Links.txt file.
As an example, the content of the Links.txt file could simply be:
https://www.youtube.com/watch?v=NDDUMon9SJM
https://www.youtube.com/watch?v=x9iAD3GZyfM
https://www.youtube.com/watch?v=fHhNWAKw0bY
https://www.youtube.com/watch?v=jYUZAF3ePFE
https://www.youtube.com/watch?v=ik4USIChrkY
https://www.youtube.com/watch?v=HgEGAaYdABA
Is there a way to use a if condition of some sort to display the exact number of urls each time?
The only post that seems related is this one but I don't really see a working solution.
Here is my current code:
---
title: "Hyperlinks_Word"
output: word_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library('rvest')
library('magrittr')
library('httr')
```
```{r }
url_proxy <- read.table("Links.txt", header = FALSE, sep = "")
url_proxy <- as.character(url_proxy$V1)
link_test <- list()
for(i in 1:length(url_proxy)){
download.file(url_proxy[i], destfile ='scrape_test.html',quiet = TRUE)
url <- read_html('scrape_test.html')
youtube_title <- url%>%html_nodes(xpath = "//title")%>%html_text()
youtube_title <- data.frame(matrix(unlist(youtube_title), nrow=length(youtube_title), byrow=T))
colnames(youtube_title) <- "youtube_title"
link_test[i] <- as.character(youtube_title$youtube_title)
}
```
`r i=1`
[`r link_test[i]`](`r url_proxy[i]`)
`r i=2`
[`r link_test[i]`](`r url_proxy[i]`)
`r i=3`
[`r link_test[i]`](`r url_proxy[i]`)
`r i=4`
[`r link_test[i]`](`r url_proxy[i]`)
One solution is to add the following to the chunk
cat(paste0("[", unlist(link_test), "](", url_proxy,")", collapse="\n\n"))
paste0 takes care of creating the hyperlinks by pasting title and URL together. Using double \n to create sufficient line break.
Use results='asis' in chunk options.
```{r, results='asis'}
url_proxy <- read.table("Links.txt", header = FALSE, sep = "")
url_proxy <- as.character(url_proxy$V1)
link_test <- list()
for(i in 1:length(url_proxy)){
download.file(url_proxy[i], destfile ='scrape_test.html',quiet = TRUE)
url <- read_html('scrape_test.html')
youtube_title <- url%>%html_nodes(xpath = "//title")%>%html_text()
youtube_title <- data.frame(matrix(unlist(youtube_title), nrow=length(youtube_title), byrow=T))
colnames(youtube_title) <- "youtube_title"
link_test[i] <- as.character(youtube_title$youtube_title)
}
cat(paste0("[", unlist(link_test), "](", url_proxy,")", collapse="\n\n"))
```
I've run my analyses in a source Rmd file and would like to knit a clean version from a final Rmd file using only a few of the chunks from the source. I've seen a few answers with regard to pulling all of the chunks from a source Rmd in Source code from Rmd file within another Rmd and How to source R Markdown file like `source('myfile.r')`?. I share the concern with these posts in that I don't want to port out a separate .R file, which seems to be the only way that read_chunk works.
I think I'm at the point where I can import the source Rmd, but now I'm not sure how to call specific chunks from it in the final Rmd. Here's a reproducible example:
SourceCode.Rmd
---
title: "Source Code"
output:
pdf_document:
latex_engine: xelatex
---
```{r}
# Load libraries
library(knitr) # Create tables
library(kableExtra) # Table formatting
# Create a dataframe
df <- data.frame(x = 1:10,
y = 11:20,
z = 21:30)
```
Some explanatory text
```{r table1}
# Potentially big block of stuff I don't want to have to copy/paste
# But I want it in the final document
kable(df, booktabs=TRUE,
caption="Big long title for whatever") %>%
kable_styling(latex_options=c("striped","HOLD_position")) %>%
column_spec(1, width="5cm") %>%
column_spec(2, width="2cm") %>%
column_spec(3, width="3cm")
```
[Some other text, plus a bunch of other chunks I don't need for anyone to see in the clean version.]
```{r}
save(df, file="Source.Rdata")
```
FinalDoc.Rmd
---
title: "Final Doc"
output:
pdf_document:
latex_engine: xelatex
---
```{r setup, include=FALSE}
# Load libraries and data
library(knitr) # Create tables
library(kableExtra) # Table formatting
opts_chunk$set(echo = FALSE)
load("Source.Rdata")
```
As far as I can tell, this is likely the best way to load up SourceCode.Rmd (from the first linked source above):
```{r}
options(knitr.duplicate.label = 'allow')
source_rmd2 <- function(file, local = FALSE, ...){
options(knitr.duplicate.label = 'allow')
tempR <- tempfile(tmpdir = ".", fileext = ".R")
on.exit(unlink(tempR))
knitr::purl(file, output=tempR, quiet = TRUE)
envir <- globalenv()
source(tempR, local = envir, ...)
}
source_rmd2("SourceCode.Rmd")
```
At this point, I'm at a loss as to how to call the specific chunk table1 from SourceCode.Rmd. I've tried the following as per instructions here with no success:
```{r table1}
```
```{r}
<<table1>>
```
The first seems to do nothing, and the second throws an unexpected input in "<<" error.
I wrote a function source_rmd_chunks() that sources chunk(s) by label name. See gist.
I am currently fighting trying to get knitr to render my leaflet maps, taken from a collection to appear correctly in a rendered RMD html-output. I'm already aware about some potential problems when looping throug collections and generating graphical output with RMD/knitr, but still I can't figure out, how to make my example work for leaflet-maps.
Reproducible working example (Test_1.Rmd):
---
title: "test1"
author: "phabee"
date: "22 Mai 2018"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
## Title 1
```{r, fig.show='asis', echo=FALSE, results='asis'}
for (i in 1:4) {
cat("### Plot Number ", i, "\n")
plot(1,1)
# use plot.new() here to force rendering of potential plot-duplicates
plot.new()
cat("\n\n")
}
```
The above example renders as expected (at least after adding plot.new(), which I've learned here from Freedomtowin). But when I try to do the same with leaflet-maps, it doesn't work at all. No single map is being rendered:
Reproducible failing example (Test_2.Rmd)
---
title: "test2"
author: "phabee"
date: "22 Mai 2018"
output: html_document
---
```{r setup, include=FALSE}
library(leaflet)
knitr::opts_chunk$set(echo = TRUE)
```
## Title 1
```{r, fig.show='asis', echo=FALSE, results='asis'}
for (i in 1:4) {
cat("### Map Number ", i, "\n")
leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(lng=174.768, lat=-36.852, popup="The birthplace of R")
cat("\n")
}
```
I would expect the second Rmd to render 4 times the same map, showing different titles ("Plot Number 1-4"). But the output doesn't render any map at all. The output looks as follows:
After inspecting the generated html-output the output, it can be seen that there is nothing rendered at all and it's not just a visibility-issue:
However, when I evaluate the leaflet-section within the 2nd Rmd directly by 'highlighting' the code and hitting ctrl-Enter, the map renders as expected:
I already tried to
convert the leaflet-statement to an assignment statement
introduce cat() or print() commands to force map-output
play around with additional newline-characters '\n' before and/or after the map output section
fiddle around with the 'asis' directives from fig.show or results
without any effect. Does anyone have a clue here?
You need to put things in a tagList, and have that list print from the chunk. This just uses default settings for fig.show and results; it also uses the htmltools::h3() function to turn the title into an HTML title directly, not using the Markdown ### marker. (You might want h2 or h4 instead.)
---
title: "test3"
output: html_document
---
```{r setup, include=FALSE}
library(leaflet)
library(htmltools)
knitr::opts_chunk$set(echo = TRUE)
```
## Title 1
```{r echo=FALSE}
html <- list()
for (i in 1:4) {
html <- c(html,
list(h3(paste0("Map Number ", i)),
leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(lng=174.768, lat=-36.852, popup="The birthplace of R")
)
)
}
tagList(html)
```
Intro:
I am trying to embed a leaflet map into a revealjs presentation within an RMarkdown file. My example below is pretty close, but it is (1) missing tiles, (2) the popups are not displaying, and (3) the legend and font are way too big!
I am not too concerned with how the code blocks look at the moment. I'm planning on using the results = "hide" slide option for my final product.
Thanks in advance!
Reproducible Example:
---
title: "My Presentation"
author: Me
date: 2017-06-23
output:
revealjs::revealjs_presentation:
theme: black
---
## Loading in necessary packages:
```{r}
library(dplyr)
library(sp)
library(rgdal)
library(rgeos)
library(RColorBrewer)
library(classInt)
library(leaflet)
library(htmlwidgets)
```
## Defining our data:
```{r}
lat <- c(45.51158000, 45.50431159, 45.496539)
lon <- c(-122.548056, -122.54775, -122.54788)
no2 <- c(17.37, 25.61, 24.69)
dta <- data.frame(lat, lon, no2)
colnames(dta) <- c("lat","lon","no2")
```
## Create layer of spatial points:
```{r}
points <- SpatialPointsDataFrame(data.frame(x=dta$lon, y=dta$lat), data = data.frame(dta$no2))
plotclr <- (brewer.pal(7, "RdYlGn"))
class <- classIntervals(dta$no2, n = 7, style = "fixed", fixedBreaks = c(0,5,10,15,20,25,30))
colcode <- findColours(class, rev(plotclr))
plot(points, col=colcode, pch=19)
pop1<-paste0("<b>NO2:</b> ", dta$no2, " ppb",
"<br /> <b>Lat:</b> ", dta$lat,
"<br /> <b>Lon:</b> ", dta$lon)
```
## Creating the leaflet map:
```{r}
no2_map <-leaflet()%>%
addTiles('http://{s}.tiles.wmflabs.org/bw-mapnik/{z}/{x}/{y}.png') %>%
addCircleMarkers(data=points, color = "black", radius = dta$no2, fillColor = colcode, fillOpacity=0.7, weight=1, popup=pop1) %>%
addLegend(position = "bottomright", colors = rev(plotclr), labels = rev(c("30","25","20","15","10","5","0")), opacity = 0.9, title = "NO2 (ppb)")
```
---
```{r}
no2_map
saveWidget(no2_map, file="map.html")
```
Unfortunately, reveal.js and Leaflet don't play very well together, and the slide with your maps might be missing layers. This is due to Leaflet not being able to discern the size of the DOM element which serves as the container of the map, because reveal.js resizes all elements dinamically.
The easiest workaround is to just refresh the page when you're in a slide with a Leaflet map. You can also try a deferred call to map.invalidateSize() (by using setTimeout() in plain Javascript)
JS leaflet allows two maps to be synchronized. See an example of synchronized leaflet maps here.
I would like to implement synchronized leaflet maps in R and more specifially in Rmarkdown/knitr.
Preferably, the maps should shown next to each other horizontally (just like in the example).
Here is a minimal Rmarkdown (.Rmd) example of two maps I would like to sync.
The solution does not have to be based on the the mapview package. Any solution is welcome really (-:
---
title: "How to sync 2 leaflet maps"
author: "me"
date: "2 April 2016"
output: html_document
---
```{r SETUP, include=FALSE}
library("mapview")
library("sp")
# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
```
```{r MAPS}
mapView(meuse, zcol="copper")#map # MAP 1
mapview(meuse, zcol="soil")#map # MAP 2
```
Here is a way to sync the two leaflet maps, but unfortunately it does not work in RStudio Viewer. This does work in Chrome and Firefox. There are lots of ways to make this much more robust. I tried to add comments in the R code below to explain what is happening.
---
title: "How to sync 2 leaflet maps"
author: "me"
date: "2 April 2016"
output: html_document
---
```{r SETUP, include=FALSE}
# get the latest htmlwidgets
# devtools::install_github("ramnathv/htmlwidgets")
library("htmlwidgets")
library("htmltools")
library("mapview")
library("sp")
# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
```
```{r MAPS}
mapView(meuse, zcol="copper")#map # MAP 1
mapview(meuse, zcol="soil")#map # MAP 2
```
```{r}
# crudely add the leaflet-sync plugin
# attachDependency with the rawgit gave me
# errors so just do this for now
# could easily add to a package
# or make a mini package to import this
# dependency
tags$script(
type="text/javascript",
src="https://cdn.rawgit.com/turban/Leaflet.Sync/master/L.Map.Sync.js"
)
```
```{r}
# this is one of the new htmlwidgets methods
# to add some code after all htmlwidgets are rendered
# this is very useful since we need all htmlwidgets rendered
# before we can sync
onStaticRenderComplete(
'
var leaf_widgets = Array.prototype.map.call(
document.querySelectorAll(".leaflet"),
function(ldiv){
return HTMLWidgets.find("#" + ldiv.id);
}
);
// make this easy since we know only two maps
leaf_widgets[0].sync(leaf_widgets[1]);
leaf_widgets[1].sync(leaf_widgets[0]);
'
)
```
Here is how we can do the same thing in straight R code.
# http://stackoverflow.com/questions/36373842/synchronizing-two-leaflet-maps-in-r-rmarkdown
# get the latest htmlwidgets
# devtools::install_github("ramnathv/htmlwidgets")
library("htmlwidgets")
library("htmltools")
library("mapview")
library("sp")
# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
map1 <- mapView(meuse, zcol="copper")#map # MAP 1
map2 <- mapview(meuse, zcol="soil")#map # MAP 2
tagList(
tags$head(tags$script(
type="text/javascript",
src="https://cdn.rawgit.com/turban/Leaflet.Sync/master/L.Map.Sync.js"
)),
map1,
map2,
onStaticRenderComplete(
'
var leaf_widgets = Array.prototype.map.call(
document.querySelectorAll(".leaflet"),
function(ldiv){
return HTMLWidgets.find("#" + ldiv.id);
}
);
// make this easy since we know only two maps
leaf_widgets[0].sync(leaf_widgets[1]);
leaf_widgets[1].sync(leaf_widgets[0]);
'
)
) %>%
browsable
And if you want it side-by-side, here is the basic way to accomplish. We could leverage shiny::fluidPage, fluidRow, and column to get boostrap, but the css/js is really heavy for just side-by-side placement.
# get the latest htmlwidgets
# devtools::install_github("ramnathv/htmlwidgets")
library("htmlwidgets")
library("htmltools")
library("shiny")
library("mapview")
library("sp")
# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
map1 <- mapView(meuse, zcol="copper")#map # MAP 1
map2 <- mapview(meuse, zcol="soil")#map # MAP 2
tagList(
tags$head(tags$script(
type="text/javascript",
src="https://cdn.rawgit.com/turban/Leaflet.Sync/master/L.Map.Sync.js"
)),
tags$div(style="display:inline;width:50%;float:left;",map1),
tags$div(style="display:inline;width:50%;float:left;",map2),
onStaticRenderComplete(
'
var leaf_widgets = Array.prototype.map.call(
document.querySelectorAll(".leaflet"),
function(ldiv){
return HTMLWidgets.find("#" + ldiv.id);
}
);
// make this easy since we know only two maps
leaf_widgets[0].sync(leaf_widgets[1]);
leaf_widgets[1].sync(leaf_widgets[0]);
'
)
) %>%
browsable
Note, we have implemented the answer provided by #timelyportfolio in package mapview so that this is now easily achievable using mapview::sync(). See ?mapview::sync for instructions and examples.