How to save a layered pdf in R (via Sweave?) - r

I've searched SO, Googled, read ?pdf, and come up dry as to the possibility of saving a plot as a pdf with layers that can be swtiched on and off in the pdf viewer margins. An example of what I'm talking about are the USGS quad topo-maps, which can be downloaded as pdfs with multiple layers, such as this (zipped pdf).
The following sentence in the pdf() help file sounds ominous, but I also wanted to check that I'm not misinterpreting it:
The R graphics model does not distinguish graphics objects at the level
of the driver interface.
I used to be able to save layered pdf's in Illustrator, but no longer have this program at my disposal. Perhaps someone can think of a workaround from within R? The data I'm using to map are large, but here's a toy example:
pdf("2objects.pdf")
plot(NULL, type = "n",xlim = c(0,1),ylim = c(0,1))
rect(0,.7,.7,0,border = "blue",lwd=2)
rect(.3,1,1,.3,border = "red",lty=2,lwd=2)
dev.off()
It looks like this (it's a png, but the above will give a pdf)
I'd like to be able to have the red and blue boxes as layers with visibility that can be switched on and off from within the pdf viewer.
Many thanks!
Edit: found thread in R-help (re: #mnel), and it looks to not be possible. I will still leave this question open, in case someone has come up with a nifty R-tastic workaround.
Edit (Sept 5th, 2012): I tried doing this via Sweave, and achieved partial success using the workaround posted here. This method produces a single pdf with 'layers' that can be switched on and off using hyperlinked text below the images. It uses 'animation' trickery to do so. While it is still not my ultimate desired outcome, it has the advantage of not depending on particular pdf viewers. I will still wait to see if someone posts a way to do layers, aka OCGs in a Sweave document, which I could then automate.
Edit (Sept 13, 2012): I posted my progress so far as an answer, using the code mentioned above. I was able to get it working in a more complex real world situation with no alterations to the code with overlays of different administrative and statistical boundaries within the US. In this case, I just named the different map overlays layer-0.pdf, layer-1.pdf, etc, and it worked without error. I still hope something better pops up here eventually.
Thanks all for you comments

I'm able to achieve this via ggplot.
library(ggplot2)
df <- data.frame(x = c(1,10), y = c(20,40), class = 1:2)
layered_plot <- ggplot(df, aes(xmin = x, xmax = x + 1, ymin = y, ymax = y + 2, fill = class)) +
geom_rect() +
opts(legend.position = "none")
# Now save this as pdf
ggsave(layered_plot, file="p1.pdf")
(This is just the png version for illustration but when I open the pdf in Illustrator, I can turn off the individual layers as needed).

Looks like the (tex) animation answer is the best I can come up with now. The following .Rnw file will create a pdf with a figure in the middle, and 2 text hyperlinks below it, which toggle visibility of the red and blue boxes independently. I found the Tex code that makes this work here. I've not looked at #Aaron's ocgtools suggestion yet, but will get there. Thanks all for your suggestions!
\documentclass{article}
%----------------------------------------------------------------%\
\usepackage[OT1]{fontenc}
\usepackage{Sweave}
\usepackage{animate}
\usepackage{hyperref}
\usepackage[margin=0.4in]{geometry}
%----------------------------------------------------------------%
\makeatletter
% command to create a toggle link
\newcommand{\ShowHideLayer}[3]{%
% #1: anim No. (zero-based),
% #2: layer No. (zero-based),
% #3: link text
\leavevmode%
\pdfstartlink user {
/Subtype /Link
/Border [\#pdfborder]%
/A <<
/S/JavaScript
/JS (
\if at anim#useocg%
if(a#1.fr[#2].state==true){
a#1.fr[#2].state=false;
}else{
a#1.fr[#2].state=true;
}
\else
if (a#1.fr[#2].display==display.visible){
a#1.fr[#2].display=display.hidden;
}else{
a#1.fr[#2].display=display.visible;
}
this.dirty=false;
\fi
)
>>
}#3%
\pdfendlink%
}
% command to create a link to show/hide all layers
\newcommand{\ShowHideAll}[2]{%
% #1: anim No. (zero-based),
% #2: link text
\leavevmode%
\pdfstartlink user {
/Subtype /Link
/Border [\#pdfborder]%
/A <<
/S/JavaScript
/JS (
var countvisible=0;
for(var i in a#1.fr){
\if at anim#useocg
if(a#1.fr[i].state==true){countvisible++;}
\else
if (a#1.fr[i].display==display.visible){countvisible++;}
\fi
}
if(countvisible){
for(var i in a#1.fr){
\if at anim#useocg
a#1.fr[i].state=false;
\else
a#1.fr[i].display=display.hidden;
this.dirty=false;
\fi
}
}
else{
for(var i in a#1.fr){
\if at anim#useocg
a#1.fr[i].state=true;
\else
a#1.fr[i].display=display.visible;
this.dirty=false;
\fi
}
}
)
>>
}#2%
\pdfendlink%
}
\makeatother
\begin{document}
% heres the R-making of the plots, saved to working directory,
% which should be the folder containing this .Rnw file
% 3 versions of the same plot, one for each layer
<<echo = FALSE, hide = TRUE>>=
pdf("layer-0.pdf")
plot(NULL, type = "n", xlim = c(0, 1), ylim = c(0, 1), xlab = "", ylab = "")
dev.off()
pdf("layer-1.pdf")
plot(NULL, type = "n", xlim = c(0, 1), ylim = c(0, 1), axes = FALSE, xlab = "", ylab = "")
rect(0, .7, .7, 0, border = "blue", lwd = 2)
dev.off()
pdf("layer-2.pdf")
plot(NULL, type = "n", xlim = c(0, 1), ylim = c(0, 1), axes = FALSE, xlab = "", ylab = "")
rect(.3, 1, 1, .3, border = "red", lty = 2, lwd = 2)
dev.off()
#
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{center}
%animated layer-set No. 0
% v-- frame rate ignored
\animategraphics[width=1\linewidth,step]{1}{layer-}{0}{2}
\ShowHideLayer{0}{1}{toggle red box}\\
\ShowHideLayer{0}{2}{toggle blue box}\\
\end{center}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\end{document}

Related

Define the conditional Jupyter cell

I have Jupyter Notebook tutorials that I used Matplotlibe and ipywidgets(interact) to display video with NumPy 3D format.
class JupyterDisplay():
def __init__(self, video, median_filter_flag=False, color='gray', imgSizex=5, imgSizey=5, IntSlider_width='500px'):
self.color = color
self.video = video
self.imgSizex = imgSizex
self.imgSizey = imgSizey
self.median_filter_flag = median_filter_flag
interact(self.display, frame=widgets.IntSlider(min=0, max=self.video.shape[0] - 1, step=1, value=10,
layout=Layout(width=IntSlider_width),
readout_format='10', continuous_update=False,
description='Frame:'))
def display(self, frame):
fig = plt.figure(figsize=(self.imgSizex, self.imgSizey))
ax = fig.add_axes([0, 0, 1, 1])
if self.median_filter_flag:
frame_v = median_filter(self.video[int(frame), :, :], 3)
else:
frame_v = self.video[int(frame), :, :]
myplot = ax.imshow(frame_v, cmap=self.color)
divider = make_axes_locatable(ax)
cax = divider.append_axes("right", size="5%", pad=0.05)
plt.colorbar(myplot, cax=cax)
plt.show()
I want to create an HTML version from tutorials with sphinx make HTML. But the video is not visualized in the HTML version. What is the best way to display dynamic video in the HTML version?
I can create the mp4 from videos, but in this case, I need to have a conditional Jupyter cell to only run this part of the code when making HTML Sphinx used. Can you inform me how I should define this conditional cell?

Automatic file numbering in ggsave as in png

In png(), the first argument is filename = "Rplot%03d.png" which causes files to be generated with ascending numbers. However, in ggsave, this doesn't work, the number always stays at the lowest number (Rplots001.png") and this file is always overwritten.
Looking at the code of the grDevices-functions (e.g. grDevices::png() it appears that the automatic naming happens in functions which are called by .External()
Is there already an implementation of this file naming functionality in R such that it is accessible outside of the grDevices functions?
Edit:
asked differently, is there a way to continue automatic numbering after shutting off and restarting a device? For example, in this code, the two later files overwrite the former ones:
png(width = 100)
plot(1:10)
plot(1:10)
dev.off()
png(width = 1000)
plot(1:10)
plot(1:10)
dev.off()
You can write a function to do this. For example, how about simply adding a time stamp. something like:
fname = function(basename = 'myfile', fileext = 'png'){
paste(basename, format(Sys.time(), " %b-%d-%Y %H-%M-%S."), fileext, sep="")
}
ggsave(fname())
Or, if you prefer sequential numbering, then something along the lines of
next_file = function(basename = 'myfile', fileext = 'png', filepath = '.'){
old.fnames = grep(paste0(basename,' \\d+\\.', fileext,'$'),
list.files(filepath), value = T)
lastnum = gsub(paste0(basename,' (\\d+)\\.', fileext,'$'), '\\1', old.fnames)
if (!length(lastnum)) {
lastnum = 1
} else {
lastnum = sort(as.integer(lastnum),T)[1] + 1L
}
return(paste0(basename, ' ', sprintf('%03i', lastnum), '.', fileext))
}
ggsave(next_file())

Native PGFPlots in JULIA language changing font size

I am using the native PGFPlots.jl plotting software in Julia language.
I will be ever so grateful if you could let me know how to change the font size of:
Title (I suspect with legend style={font=\small})
legend
xlabel
ylabel
My code:
pushPGFPlotsOptions("scale=1.5")
Plot1 = GroupPlot(2, 2, groupStyle = "horizontal sep = 1.6cm, vertical sep = 2.cm")
push!(Plot1b, Axis([
Plots.Linear(Se, H_Kg, mark="none", style="red, very thick"),
Plots.Linear(Se, H_Vg, mark="none", style="dashed, blue, very thick"),
], title="Se(H)", xlabel=L"$Se[-]$", ylabel=L"$H[cm]$", style="smooth", xmin=Se_Min, xmax=Se_Max, ymin=H_Min, ymode="log"))
push!(Plot1, Axis([
Plots.Linear(Se, Kunsat_Kg, mark="none", style="red, very thick", legendentry=L"$KG$"),
Plots.Linear(Se, Kunsat_Vg, mark="none", style="dashed, blue, very thick", legendentry=L"$VG$"),
], title="K(Se)", xlabel=L"$Se[-]$", ylabel=L"$K(Se)[cm/h]$", style="smooth", xmin=Se_Min, xmax=Se_Max, ymin=K_Min, legendStyle = "{at={(-0.3,-0.4)}, anchor=south west, legend columns=-1}"))
save(Path, Plot1)
Many thanks for any help you may provide,

Bokeh Colorbar Vertical title to right of colorbar?

I'm trying to do something that I'd normally consider trivial but seems to be very difficult in bokeh: Adding a vertical colorbar to a plot and then having the title of the colorbar (a.k.a. the variable behind the colormapping) appear to one side of the colorbar but rotated 90 degrees clockwise from horizontal.
From what I can tell of the bokeh ColorBar() interface (looking at both documentation and using the python interpreter's help() function for this element), this is not possible. In desperation I have added my own Label()-based annotation. This works but is klunky and displays odd behavior when deployed in a bokeh serve situation--that the width of the data window on the plot varies inversely with the length of the title colorbar's title string.
Below I've included a modified version of the bokeh server mpg example. Apologies for its complexity, but I felt this was the best way to illustrate the problem using infrastructure/data that ships with bokeh. For those unfamiliar with bokeh serve, this code snippet needs to saved to a file named main.py that resides in a directory--for the sake of argument let's say CrossFilter2--and in the parent directory of CrossFilter2 one needs to invoke the command
bokeh serve --show CrossFilter2
this will then display in a browser window (localhost:5006/CrossFilter2) and if you play with the color selection widget you will see what I mean, namely that short variable names such as 'hp' or 'mpg' result in a wider data display windows than longer variable names such as 'accel' or 'weight'. I suspect that there may be a bug in how label elements are sized--that their x and y dimensions are swapped--and that bokeh has not understood that the label element has been rotated.
My questions are:
Must I really have to go to this kind of trouble to get a simple colorbar label feature that I can get with little-to-no trouble in matplotlib/plotly?
If I must go through the hassle you can see in my sample code, is there some other way I can do this that avoids the data window width problem?
import numpy as np
import pandas as pd
from bokeh.layouts import row, widgetbox
from bokeh.models import Select
from bokeh.models import HoverTool, ColorBar, LinearColorMapper, Label
from bokeh.palettes import Spectral5
from bokeh.plotting import curdoc, figure, ColumnDataSource
from bokeh.sampledata.autompg import autompg_clean as df
df = df.copy()
SIZES = list(range(6, 22, 3))
COLORS = Spectral5
# data cleanup
df.cyl = df.cyl.astype(str)
df.yr = df.yr.astype(str)
columns = sorted(df.columns)
discrete = [x for x in columns if df[x].dtype == object]
continuous = [x for x in columns if x not in discrete]
quantileable = [x for x in continuous if len(df[x].unique()) > 20]
def create_figure():
xs = df[x.value].tolist()
ys = df[y.value].tolist()
x_title = x.value.title()
y_title = y.value.title()
name = df['name'].tolist()
kw = dict()
if x.value in discrete:
kw['x_range'] = sorted(set(xs))
if y.value in discrete:
kw['y_range'] = sorted(set(ys))
kw['title'] = "%s vs %s" % (y_title, x_title)
p = figure(plot_height=600, plot_width=800,
tools='pan,box_zoom,wheel_zoom,lasso_select,reset,save',
toolbar_location='above', **kw)
p.xaxis.axis_label = x_title
p.yaxis.axis_label = y_title
if x.value in discrete:
p.xaxis.major_label_orientation = pd.np.pi / 4
if size.value != 'None':
groups = pd.qcut(df[size.value].values, len(SIZES))
sz = [SIZES[xx] for xx in groups.codes]
else:
sz = [9] * len(xs)
if color.value != 'None':
coloring = df[color.value].tolist()
cv_95 = np.percentile(np.asarray(coloring), 95)
mapper = LinearColorMapper(palette=Spectral5,
low=cv_min, high=cv_95)
mapper.low_color = 'blue'
mapper.high_color = 'red'
add_color_bar = True
ninety_degrees = pd.np.pi / 2.
color_bar = ColorBar(color_mapper=mapper, title='',
#title=color.value.title(),
title_text_font_style='bold',
title_text_font_size='20px',
title_text_align='center',
orientation='vertical',
major_label_text_font_size='16px',
major_label_text_font_style='bold',
label_standoff=8,
major_tick_line_color='black',
major_tick_line_width=3,
major_tick_in=12,
location=(0,0))
else:
c = ['#31AADE'] * len(xs)
add_color_bar = False
if add_color_bar:
source = ColumnDataSource(data=dict(x=xs, y=ys,
c=coloring, size=sz, name=name))
else:
source = ColumnDataSource(data=dict(x=xs, y=ys, color=c,
size=sz, name=name))
if add_color_bar:
p.circle('x', 'y', fill_color={'field': 'c',
'transform': mapper},
line_color=None, size='size', source=source)
else:
p.circle('x', 'y', color='color', size='size', source=source)
p.add_tools(HoverTool(tooltips=[('x', '#x'), ('y', '#y'),
('desc', '#name')]))
if add_color_bar:
color_bar_label = Label(text=color.value.title(),
angle=ninety_degrees,
text_color='black',
text_font_style='bold',
text_font_size='20px',
x=25, y=300,
x_units='screen', y_units='screen')
p.add_layout(color_bar, 'right')
p.add_layout(color_bar_label, 'right')
return p
def update(attr, old, new):
layout.children[1] = create_figure()
x = Select(title='X-Axis', value='mpg', options=columns)
x.on_change('value', update)
y = Select(title='Y-Axis', value='hp', options=columns)
y.on_change('value', update)
size = Select(title='Size', value='None',
options=['None'] + quantileable)
size.on_change('value', update)
color = Select(title='Color', value='None',
options=['None'] + quantileable)
color.on_change('value', update)
controls = widgetbox([x, y, color, size], width=200)
layout = row(controls, create_figure())
curdoc().add_root(layout)
curdoc().title = "Crossfilter"
You can add a vertical label to the Colorbar by plotting it on a separate axis and adding a title to this axis. To illustrate this, here's a modified version of Bokeh's standard Colorbar example (found here):
import numpy as np
from bokeh.plotting import figure, output_file, show
from bokeh.models import LogColorMapper, LogTicker, ColorBar
from bokeh.layouts import row
plot_height = 500
plot_width = 500
color_bar_height = plot_height + 11
color_bar_width = 180
output_file('color_bar.html')
def normal2d(X, Y, sigx=1.0, sigy=1.0, mux=0.0, muy=0.0):
z = (X-mux)**2 / sigx**2 + (Y-muy)**2 / sigy**2
return np.exp(-z/2) / (2 * np.pi * sigx * sigy)
X, Y = np.mgrid[-3:3:100j, -2:2:100j]
Z = normal2d(X, Y, 0.1, 0.2, 1.0, 1.0) + 0.1*normal2d(X, Y, 1.0, 1.0)
image = Z * 1e6
color_mapper = LogColorMapper(palette="Viridis256", low=1, high=1e7)
plot = figure(x_range=(0,1), y_range=(0,1), toolbar_location=None,
width=plot_width, height=plot_height)
plot.image(image=[image], color_mapper=color_mapper,
dh=[1.0], dw=[1.0], x=[0], y=[0])
Now, to make the Colorbar, create a separate dummy plot, add the Colorbar to the dummy plot and place it next to the main plot. Add the Colorbar label as the title of the dummy plot and center it appropriately.
color_bar = ColorBar(color_mapper=color_mapper, ticker=LogTicker(),
label_standoff=12, border_line_color=None, location=(0,0))
color_bar_plot = figure(title="My color bar title", title_location="right",
height=color_bar_height, width=color_bar_width,
toolbar_location=None, min_border=0,
outline_line_color=None)
color_bar_plot.add_layout(color_bar, 'right')
color_bar_plot.title.align="center"
color_bar_plot.title.text_font_size = '12pt'
layout = row(plot, color_bar_plot)
show(layout)
This gives the following output image:
One thing to look out for is that color_bar_width is set wide enough to incorporate both the Colorbar, its axes labels and the Colorbar label. If the width is set too small, you will get an error and the plot won't render.
As of Bokeh 0.12.10 there is no built in label available for colorbars. In addition to your approach or something like it, another possibility would be a custom extension, though that is similarly not trivial.
Offhand, a colobar label certainly seems like a reasonable thing to consider. Regarding the notion that it ought to be trivially available, if you polled all users about what they consider should be trivially available, there will be thousands of different suggestions for what to prioritize. As is very often the case in the OSS world, there are far more possible things to do, than there are people to do them (less than 3 in this case). So, would first suggest a GitHub Issue to request the feature, and second, if you have the ability, volunteering to help implement it. Your contribution would be valuable and appreciated by many.

Legends on R Leaflet Maps

While I realize that putting legends on maps using the Rstudio leaflet package is still a work in progress, I've been trying to add a legend post-hoc to the HTML that R generates.
library("leaflet")
set.seed(100)
pdf <- data.frame(Latitude = runif(100, -90,90), Longitude = runif(100, -180,180),
col=rep(c("red", "blue"), 50 ))
#just red
leaflet(pdf) %>% addTiles() %>%
addCircleMarkers(lat = ~ Latitude, lng = ~ Longitude, color= ~col)
I've been trying to adapt the code from http://leafletjs.com/examples/choropleth.html and figure out where to add it to the output from running the above code in R and turning it into HTML.
So something like putting the following in the body of the html:
<script>
var legend = L.control({position: 'bottomright'});
legend.onAdd = function (map) {
var div = L.DomUtil.create('div', 'info legend'),
grades = [red, blue],
labels = [];
// loop through our density intervals and generate a label with a colored square for each label
for (var i = 0; i < grades.length; i++) {
div.innerHTML +=
'<i style="background:' + getColor(grades[i] + 1) + '"></i> ' +
grades[i] + (grades[i + 1] ? '–' + grades[i + 1] + '<br>' : '+');
}
return div;
};
legend.addTo(map);
<script>
This doesn't seem to work, however. Nothing pops up. Nor is it clear how I would use names other than 'red', and 'blue' for the grades, as it were. I've also added in CSS as shown in the choropleth example as well, but no dice.
Has anyone done this - manually added a legend to their R output (say, grabbing the source from Rpubs after publishing) to add a legend?
While this is not quite what I was looking for, it appears that an addLegend function is on its way, and is in one branch of the package. See some documentation and and an example here:
http://smartinsightsfromdata.github.io//2015/04/25/choropleths.html

Resources