I'm trying to save my plot with resolution of 300 for publication purposes. The usual methods to save plots with png device isn't working and saves a blank png. Is there something else I can try, or a different package that does something similar?
library(radarchart)
data<-data.frame(Field=c("Age","Sex","Submission"), y=sample(1:100,3), x=sample(1:100,3))
path<-"C:\\Desktop\\R\\"
png(file=paste0(path,"Radar",".png"), width=500, height=500, res=300)
plot<-chartJSRadar(scores=data, labelSize= 10, main="Completeness Radar", maxScale = 100)
print(plot)
dev.off()
I've also tried:
png(file=paste0(path,"Radar",".png"), width=500, height=500, res=300)
chartJSRadar(scores=data, labelSize= 10, main="Completeness Radar", maxScale = 100)
dev.off()
library(radarchart)
library(webshot)
library(htmlwidgets)
dat <- data.frame(
Field = c("Age","Sex","Submission"),
y = sample(1:100,3),
x = sample(1:100,3)
)
plt <- chartJSRadar(
scores = dat,
labelSize= 10,
main="Completeness Radar",
maxScale = 100
)
saveWidget(plt, "plt.html")
webshot("plt.html")
magick::image_read("webshot.png")
radar charts are very difficult for folks to grok
data and plot are suberbad variable names
whitespace is your bff
webshot can limit target area
various magick ƒ()s can crop target area
consider using http://www.ggplot2-exts.org/ggradar.html
Related
using ggsave and a for loop, I know I can save multiple ggplots onto an excel spreadsheet
For example from Save multiple ggplots using a for loop :
for (i in uniq_species) {
temp_plot = ggplot(data= subset(iris, Species == i)) +
geom_point(size=3, aes(x=Petal.Length, y=Petal.Width )) + ggtitle(i)
ggsave(temp_plot, file=paste0("plot_", i,".png"), width = 14, height = 10, units = "cm")
}
But would I would like to do is avoid the loop, as I have a list of plots.
Using lapply I have ( I presume) a list of plots:
y.plot = lapply(1:nrow(df), function(row)
{
...
}
my question is, is there a way to take y.plot from above, and shove all of the graphs in there onto one excel spreadsheet, without a loop?
something like: ggsave(pic_path,plot=y.plot,width = 20,height=20,units='cm')
but this doesn't work
Perhaps, you are looking for this
dfs <- c("cars","pressure","mtcars")
my_plots <- list()
y.plot <- list()
en <- length(dfs)
y.plot <- lapply(1:en, function(i){
df <- get(dfs[i])
varname <- colnames(df)
x=df[,1]
y=df[,2]
my_plots[[i]] <- ggplot(data=df,aes(x=x,y=y)) + geom_point() +
labs(x=varname[1], y=varname[2]) + theme_bw()
})
myplots <- do.call(grid.arrange, c(y.plot, ncol = en))
location <- "C:\\_My Work\\RStuff\\GWS\\"
ggsave(plot=myplots, file=paste0(location,"myplots.png"), width = 14, height = 10, units = "cm")
Please note that ggsave currently recognises the extensions eps/ps, tex (pictex), pdf, jpeg, tiff, png, bmp, svg and wmf (windows only).
If you wish to save it to a excel file, you need to save the image as a jpeg file and then use openxslx as shown below
ggsave(plot=myplots, file=paste0(location,"myplots.jpeg"), width = 14, height = 10, units = "cm")
pic_path <- paste0(location,"myplots.jpeg")
# Add to a new work book -------------
wb <- openxlsx::createWorkbook()
addWorksheet(wb, "Plots")
insertImage(wb, "Plots", pic_path)
openxlsx::saveWorkbook(wb, file=paste0(location,"myplots.xlsx"), overwrite = TRUE)
# Kill pic
unlink(pic_path)
I am looking to plot a stop-motion animation of a sequence of plots in R. These will show dots moving around on a trajectory. I would like to show a map in the background so that the locations of the moving points correspond to the map coordinates. The way I have been doing this is through RgoogleMaps, where I created a map object and then stored it as a png file, then I set it as the background of the plot using the rasterImage function. Ultimately I am trying to have this be a shiny app (code below).
The problem is that the animation speed I have in shiny is too fast (I can slow it down but it doesn't look as good), so the plot goes opaque because it can't process it fast enough.
Basically I want to show one set of points per iteration with the same background. Is there a more efficient way to do this? Is there a way to, say, set the background image permanently without having to plot it each time. I save some time by using recordPlot() and then replaying it, but it still doesn't completely solve the problem. I have also tried seeing if I can make the raster lower resolution but the maxpixels and col arguments in as.raster don't seem to be doing anything for me.
I am not 100% sold on having to use GoogleMaps if there is a similar alternative that is much more efficient and will achieve roughly the same thing.
BC_googlemaps_point
library(shiny)
library(colorspace)
library(raster)
library(grDevices)
library(png)
#a png from Google Maps of the area above
bc_longlat_map_img <- png::readPNG("BC_googlemaps_point.png")
bc_longlat_map_img_ras <- grDevices::as.raster(bc_longlat_map_img, maxpixels=100)
bbox <- matrix(c(33.68208, -118.0554, 33.70493, -118.0279), byrow=TRUE, ncol=2)
rownames(bbox) <- c("lon","lat")
colnames(bbox) <- c("min","max")
#make some fake data
pt_data <- matrix(NA,nrow=1000, ncol=2)
colnames(pt_data) <- c("lon","lat")
#length of each side
plot_dims <- apply(bbox,1,diff)
pt_data[1:250,"lon"] <- bbox["lon","min"] + 0.2*plot_dims["lon"]
pt_data[1:250,"lat"] <- seq(bbox["lat","min"]+0.2*plot_dims["lat"], bbox["lat","max"]-0.2*plot_dims["lat"], length.out=250)
pt_data[251:500,"lon"] <- seq(bbox["lon","min"]+0.2*plot_dims["lon"], bbox["lon","max"]-0.2*plot_dims["lon"], length.out=250)
pt_data[251:500,"lat"] <- bbox["lat","max"] - 0.2*plot_dims["lat"]
pt_data[501:750,"lon"] <- bbox["lon","max"] - 0.2*plot_dims["lon"]
pt_data[501:750,"lat"] <- seq(bbox["lat","max"]-0.2*plot_dims["lat"], bbox["lat","min"]+0.2*plot_dims["lat"], length.out=250)
pt_data[751:1000,"lon"] <- seq(bbox["lon","max"]-0.2*plot_dims["lon"], bbox["lon","min"]+0.2*plot_dims["lon"], length.out=250)
pt_data[751:1000,"lat"] <- bbox["lat","min"] + 0.2*plot_dims["lat"]
#this is the slowest, have to replot the whole thing each time
for (ii in 1:1000) {
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
#read in current plots limits to fit Raster Image to
lims <- par()$usr
rasterImage(bc_longlat_map_img_ras, xleft=lims[1], ybottom=lims[3], xright=lims[2], ytop=lims[4])
points(x=pt_data[ii,"lon"], y=pt_data[ii,"lat"], pch=19, cex=3)
}
#plot first, then record, and only replay each time
#seems to be a bit faster
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
#read in current plots limits to fit Raster Image to
lims <- par()$usr
rasterImage(bc_longlat_map_img_ras, xleft=lims[1], ybottom=lims[3], xright=lims[2], ytop=lims[4])
plot_back <- recordPlot()
for (ii in 1:1000) {
replayPlot(plot_back)
points(x=pt_data[ii,"lon"], y=pt_data[ii,"lat"], pch=19, cex=3)
}
#example without the map background. very fast.
for (ii in 1:1000) {
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
points(x=pt_data[ii,"lon"], y=pt_data[ii,"lat"], pch=19, cex=3)
}
The shiny app I am trying to implement looks like this (code is repetitive):
shark_vis <- shinyApp(
ui= shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel("Inputs",
sliderInput("iter","Progress of simulation",value=1, min=1, max=1000, round=TRUE, step=1,
animate=animationOptions(interval=100, loop=FALSE))),
mainPanel(plotOutput("plot"))
)
)
),
server=shinyServer(
function(input, output) {
#current image dimensions
bbox <- matrix(c(33.68208, -118.0554, 33.70493, -118.0279), byrow=TRUE, ncol=2)
rownames(bbox) <- c("lon","lat")
colnames(bbox) <- c("min","max")
#make some fake data
pt_data <- matrix(NA,nrow=1000, ncol=2)
colnames(pt_data) <- c("lon","lat")
#length of each side
plot_dims <- apply(bbox,1,diff)
pt_data[1:250,"lon"] <- bbox["lon","min"] + 0.2*plot_dims["lon"]
pt_data[1:250,"lat"] <- seq(bbox["lat","min"]+0.2*plot_dims["lat"], bbox["lat","max"]-0.2*plot_dims["lat"], length.out=250)
pt_data[251:500,"lon"] <- seq(bbox["lon","min"]+0.2*plot_dims["lon"], bbox["lon","max"]-0.2*plot_dims["lon"], length.out=250)
pt_data[251:500,"lat"] <- bbox["lat","max"] - 0.2*plot_dims["lat"]
pt_data[501:750,"lon"] <- bbox["lon","max"] - 0.2*plot_dims["lon"]
pt_data[501:750,"lat"] <- seq(bbox["lat","max"]-0.2*plot_dims["lat"], bbox["lat","min"]+0.2*plot_dims["lat"], length.out=250)
pt_data[751:1000,"lon"] <- seq(bbox["lon","max"]-0.2*plot_dims["lon"], bbox["lon","min"]+0.2*plot_dims["lon"], length.out=250)
pt_data[751:1000,"lat"] <- bbox["lat","min"] + 0.2*plot_dims["lat"]
#plot and store
plot(bbox["lon",1]-1000, bbox["lat",1]-1000, xlim=bbox["lon",], ylim=bbox["lat",], xlab="Longitude", ylab="Latitude", las=1)
#read in current plots limits to fit Raster Image to
lims <- par()$usr
rasterImage(bc_longlat_map_img_ras, xleft=lims[1], ybottom=lims[3], xright=lims[2], ytop=lims[4])
plot_back <- recordPlot()
output$plot <- renderPlot({
replayPlot(plot_back)
points(x=pt_data[input$iter,"lon"], y=pt_data[input$iter,"lat"], pch=19, cex=3, col=1:2)
})
}
)
)
runApp(shark_vis)
You can use my googleway package to 'simulate' an animation onto an actual Google Map.
I've simplified your example so I could get it to work, but the idea should translate to your example too.
Here I'm animating the route between Melbourne and Sydney
To do the animation you load a series of circles onto the map, then set the opacity to either 0 or 1 depending on which ones you want shown.
In this instance the ones you want shown are dependant on the value of the input slider.
The trick to avoid re-drawing the map and shapes each time is to load all the circles at the start, then use the update_circles() function to change the attributes (i.e., opacity) of the circles.
Notes:
You need a valid Google Maps Javascript API key
The input data must be a data.frame, not a matrix
I haven't found the 'break' point yet - i.e., the point at which there are too many circles that they can't update quick enough
library(shiny)
library(googleway)
ui <- fluidPage(
sliderInput(inputId = "mySlider", label = "slider", min = 0, max = 222, value = 0, step = 1,
animate = animationOptions(interval=100, loop=FALSE)),
google_mapOutput("myMap", height = 800)
)
server <- function(input, output){
polyline <- "rqxeF_cxsZgr#xmCekBhMunGnWc_Ank#vBpyCqjAfbAqmBjXydAe{AoF{oEgTqjGur#ch#qfAhUuiCww#}kEtOepAtdD{dDf~BsgIuj#}tHi{C{bGg{#{rGsmG_bDbW{wCuTyiBajBytF_oAyaI}K}bEkqA{jDg^epJmbB{gC}v#i~D`#gkGmJ_kEojD_O{`FqvCetE}bGgbDm_BqpD}pEqdGiaBo{FglEg_Su~CegHw`Cm`Hv[mxFwaAisAklCuUgzAqmCalJajLqfDedHgyC_yHibCizK~Xo_DuqAojDshAeaEpg#g`Dy|DgtNswBcgDiaAgEqgBozB{jEejQ}p#ckIc~HmvFkgAsfGmjCcaJwwD}~AycCrx#skCwUqwN{yKygH}nF_qAgyOep#slIehDcmDieDkoEiuCg|LrKo~Eb}Bw{Ef^klG_AgdFqvAaxBgoDeqBwoDypEeiFkjBa|Ks}#gr#c}IkE_qEqo#syCgG{iEazAmeBmeCqvA}rCq_AixEemHszB_SisB}mEgeEenCqeDab#iwAmZg^guB}cCk_F_iAmkGsu#abDsoBylBk`Bm_CsfD{jFgrAerB{gDkw#{|EacB_jDmmAsjC{yBsyFaqFqfEi_Ei~C{yAmwFt{B{fBwKql#onBmtCq`IomFmdGueD_kDssAwsCyqDkx#e\\kwEyUstC}uAe|Ac|BakGpGkfGuc#qnDguBatBot#}kD_pBmmCkdAgkB}jBaIyoC}xAexHka#cz#ahCcfCayBqvBgtBsuDxb#yiDe{Ikt#c{DwhBydEynDojCapAq}AuAksBxPk{EgPgkJ{gA}tGsJezKbcAcdK__#uuBn_AcuGsjDwvC_|AwbE}~#wnErZ{nGr_#stEjbDakFf_#clDmKkwBbpAi_DlgA{lArLukCBukJol#w~DfCcpBwnAghCweA}{EmyAgaEbNybGeV}kCtjAq{EveBwuHlb#gyIg\\gmEhBw{G{dAmpHp_#a|MsnCcuGy~#agIe#e`KkoA}lBspBs^}sAmgIdpAumE{Y_|Oe|CioKouFwuIqnCmlDoHamBiuAgnDqp#yqIkmEqaIozAohAykDymA{uEgiE}fFehBgnCgrGmwCkiLurBkhL{jHcrGs}GkhFwpDezGgjEe_EsoBmm#g}KimLizEgbA{~DwfCwvFmhBuvBy~DsqCicBatC{z#mlCkkDoaDw_BagA}|Bii#kgCpj#}{E}b#cuJxQwkK}j#exF`UanFzM{fFumB}fCirHoTml#CoAh`A"
df <- decode_pl(polyline)
df$opacity <- 1
df$id <- 1:nrow(df)
rv <- reactiveValues()
rv$df <- df
map_key <- "your_api_key"
output$myMap <- renderGoogle_map({
google_map(key = map_key, data = df) %>%
add_circles(radius = 1000, id = "id", lat = "lat", lon = "lon",
fill_opacity = "opacity", stroke_opacity = "opacity")
})
observeEvent({
input$mySlider
},{
r <- input$mySlider
rv$df[r, "opacity"] <- 1
rv$df[-r, "opacity"] <- 0
google_map_update(map_id = "myMap") %>%
update_circles(data = rv$df, radius = 1000, id = "id",
fill_opacity = "opacity", stroke_opacity = "opacity")
})
}
shinyApp(ui, server)
Screenshots
Starting state: showing everything
step 34 on the slider
step 44 on the slider
step 82 on the slider
Quick question all.
I have some data in sql server which i have loaded into RStudio. I have made a barchart for the data and now i am using leaflet library with the use of latitude and longitude to plot a point on the map. I want to be able to use popup to show a barchart in it when the user clicks on the point.
BarChart code (maybe this is a problem because i am using googleVis library so not sure if i can use this in the popup. but again this is the most appropriate bar graph i can make and need- other suggestions could be helpful as i am not a professional in R libraries yet)
Switzerland <- sqlQuery(con, "sql query")
SwitzerlandChart <- gvisBarChart(Switzerland, options = list(height=200))
For the graph plot the code is:
m <- leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addCircles(lng=8.498868, lat=46.9221, popup=paste(plot(SwitzerlandChart)))
When i run this code it opens a webpage to view my barplot.
Then i run the following:
m #Prints the graph
This prints the graph with the point in the desired location but the popup shows me a webpage instead which also only i can open.
I want to be able to plot the bargraph inside the popup please.
Hope someone can help
Maybe a little late but here's a solution. The addPopups() function in library(leaflet) seems to be able to handle .svg files. Therefore, you could simply save your plot using svg() and then read it again using readLines(). Here's a reproducible example using library(mapview):
library(lattice)
library(mapview)
library(sp)
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
clr <- rep("grey", length(meuse))
fldr <- tempfile()
dir.create(fldr)
pop <- lapply(seq(length(meuse)), function(i) {
clr[i] <- "red"
p <- xyplot(meuse$cadmium ~ meuse$copper,
col = clr, pch = 20, alpha = 0.7)
svg(filename = paste(fldr, "test.svg", sep = "/"),
width = 250 * 0.01334, height = 250 * 0.01334)
print(p)
dev.off()
tst <- paste(readLines(paste(fldr, "test.svg", sep = "/")), collapse = "")
return(tst)
})
mapview(meuse, popup = pop, cex = "cadmium")
You will see that each popup is a scatterplot. As for a leaflet example, consider this:
content <- pop[[1]]
leaflet() %>% addTiles() %>%
addPopups(-122.327298, 47.597131, content,
options = popupOptions(closeButton = FALSE)
)
In case you need the plot to be interactive, you could have a look at library(gridSVG) which is able to produce interactive svg plots from e.g. lattice or ggplot2 plots.
UPDATE:
library(mapview) now has designated functionality for this:
popupGraph: to embed lattice, ggplot2 or interactive hatmlwidgets based plots.
popupImage: to embed local or remote (web) images
This is currently only available in the development version of mapview which can be installed with:
devtools::install_github("environmentalinformatics-marburg/mapview", ref = "develop"
This may be a little late too, but here is a full leaflet implementation. I first create the plot and then use the popupGraph function to add it in.
# make a plot of the two columns in the dataset
p <- xyplot(Home ~ Auto, data = Jun, col = "orange", pch = 20, cex = 2)
# make one for each data point
p <- mget(rep("p", length(Jun)))
# color code it so that the corresponding points are dark green
clr <- rep("orange", length(Jun))
p <- lapply(1:length(p), function(i) {
clr[i] <- "dark green"
update(p[[i]], col = clr)
})
# now make the leaflet map
m1 <- leaflet() %>%
addTiles() %>%
setView(lng = -72, lat = 41, zoom = 8) %>%
# add the markers for the Jun dataset
# use the popupGraph function
addCircleMarkers(data = Jun, lat = ~Lat, lng = ~Lon,
color = ~beatCol(BeatHomeLvl), popup = popupGraph(p),
radius = ~sqrt(BeatHome*50), group = 'Home - Jun') %>%
# layer control
addLayersControl(
overlayGroups = c('Home - Jun'
),
options = layersControlOptions(collapsed = F)
) %>%
# legend for compare to average
addLegend('bottomright', pal = beatCol, values = last$BeatTotalLvl,
title = 'Compare<br>Quote Count to<br>3Mos State Avg',
opacity = 1)
m1
Here is the output.
I'm using the following code to create a Sankey Diagram using rCharts. I wish to increase the font size of the text printed on the Sankey Diagram. I can't find a manual to show me how to do this. Thoughts?
rm(list = ls())
require(reshape)
require(rCharts)
require(rjson)
target <- c('TMF', 'TMF', 'TMF','Evaporation','Mill Reclaim','Void Losses','Seepage')
source <- c('Precipitation & Run Off','Slurry','Other','TMF','TMF','TMF','TMF')
value <- c(638,1610,755,118,1430,466,2)
x <- data.frame(target,source,value)
sankeyPlot <- rCharts$new()
sankeyPlot$set(
data = x,
nodeWidth = 10,
nodePadding = 10,
layout = 32,
width = 1100,
height = 675,
units = "cubic metres",
title = "Sankey Diagram"
)
sankeyPlot$setLib('http://timelyportfolio.github.io/rCharts_d3_sankey')
sankeyPlot
Based on this answer you can add scripts to customize your plots. To change the text-size, you could add:
sankeyPlot$setTemplate(
afterScript = "
<script>
d3.selectAll('#{{ chartId }} svg text')
.style('font-size', '55')
</script>
")
I was able to change the font size after creating the sankey diagram by setting the fontSize option:
#create sankey diagram
p<-sankeyNetwork(...)
#the default font size
> p$x$options$fontSize
[1] 7
#set desired font size
p$x$options$fontSize<-10
I'm working with the ggmap tutorial by Manuel Amunategui over at http://amunategui.github.io/ggmap-example/. It is a wonderful introduction to the ggmap package and thankfully I understand his tutorial.
However, I am also trying to make this material interactive through R markdown. When I run the below document, for some reason the rendering of the map is of very low quality. In my standard .R script the image produced is way better. Any thoughts as to what might cause the drastic difference in quality?
Also, in R Markdown, is it possible to have custom sizing of the images as well as placement? I am specifically interested in making the map larger and/or displaying another map with it side-by-side.
This first block of code is just to get your hands on the data if desired.
#install.packages("RCurl"); install.packages("xlsx"); install.packages("zipcode"); install.packages("ggmap")
library(RCurl)
library(xlsx)
# NOTE if you can't download the file automatically, download it manually at:
#'http://www.psc.isr.umich.edu/dis/census/Features/tract2zip/'
urlfile <-'http://www.psc.isr.umich.edu/dis/census/Features/tract2zip/MedianZIP-3.xlsx'
destfile <- "census20062010.xlsx"
download.file(urlfile, destfile, mode="wb")
census <- read.xlsx2(destfile, sheetName = "Median")
#census <- read.xlsx2(file = "census20062010.xlsx", sheetName = "Median")
head(census)
# clean up data
# census <- census[c('Zip','Median..', 'Pop')]
names(census) <- c('Zip','Median', 'Pop')
census$Median <- as.character(census$Median)
census$Median <- as.numeric(gsub(',','',census$Median))
census$Pop <- as.numeric(gsub(',','',census$Pop))
head(census)
# get geographical coordinates from zipcode
library(zipcode)
data(zipcode)
census$Zip <- clean.zipcodes(census$Zip)
census <- merge(census, zipcode, by.x='Zip', by.y='zip')
census$location <- paste0(census$city, ", ", census$state)
names(census) <- sapply(names(census), tolower)
# saved census to census.rdata at this point...
The next chunk of code below is what is in the markdown file.
```{r, message=FALSE, echo=FALSE}
library(ggmap)
library(ggplot2)
load("census.rdata")
inputPanel(
textInput("loc", label = "Location", value = "Orlando, FL"),
sliderInput("zoom", label = "Zoom Level",
min = 1, max = 12, value = 10, step = 1)
)
renderPlot({
census2 <- census[census$location == input$loc,]
map <- get_map(location = input$loc,
zoom = input$zoom,
maptype = 'roadmap',
source = 'google',
color = 'color',
filename = "ggmapTemp")
print(ggmap(map) +
geom_point(
aes(x=longitude, y=latitude,
show_guide = TRUE, size=Median),
data=census2, colour = I('red'), na.rm = T)
)
})
```
Thanks for your help!