Samrat
Samrat

Reputation: 89

Improving graph quality while exporting in r

I have written following code for comparing between to different variables over a period. The code works fine but only problem is when i output the file as "jpeg" the lines are not smooth and my arrow is not as smooth as i like it to be in other words the graph feels very low quality. But when i output it as "pdf" i get smooth lines and graph is of higher quality. But pdf files are high in file size and i need to insert these graphs in word file. I find it relatively easy to append jpeg into the word file. So is it possible to improve image quality while being in jpeg format. I tried using res argument in jpeg() but it doesnot output the graph as it is displayed in the rstudio.

I will appreciate the help. Thanks!

code:

library(shape)
library(Hmisc)
### samples ######
xaxs = seq(1,30,length=30)
precip = sample(200:800, 30)
ero = sample(0:10, 30, replace = T)
#########

svpth = getwd()
nm = "try.jpeg"
jpeg(paste0(svpth,"/",nm), width=950 , height =760, quality = 200, pointsize =15)
par(mar= c(5,4,2,4), oma=c(1,1,1,1))
plot(xaxs,precip, type = "p", pch=15, col="green", ylim = c(200,1000),
     xlab = "Year" , ylab = "", cex.main=1.5, cex.axis=1.5, cex.lab=1.5)
lines(xaxs, precip,lty =1, col="green")
# xtick<-seq(0,30, by=1)
# axis(side = 1, at=xtick, labels = FALSE )
minor.tick(nx=5, ny=2, tick.ratio=0.5, x.args = list(), y.args = list())
mtext("Depth (mm)", side = 2, line = 2.7, cex = 1.5)
par(new=T)
plot(xaxs, (ero * 10), ylim = c(0,max(pretty(range((ero * 10))))+20), type = "p", pch=20, cex=1.5, col="red", axes = F, xlab = "", ylab = "")
lines(xaxs, (ero * 10),lty =2, col="red")
axis(side = 4, at=pretty(range((ero * 10))), cex.axis = 1.5)
# mtext("Erosion (t/ha/yr)", side = 4, line = 2.2, cex = 1.5)
mtext(expression(paste("Erosion (t ", ha^-1, yr^-1, ")")), side = 4, line = 2.7, cex = 1.5)
legend("topleft", legend = c("Precipitation","Erosion"), lty = c(1,2), pch = c(15,20), col = c("green","red"), cex = 1.6, bty = "n")
####arrow
Arrows(7, 85, 11, 90,lwd= 1.1)
Arrows(26, 85, 21, 90, lwd= 1.1)
txt = "High erosion rates in \nwheat-planting years"
xt = 16
yt = 85
text(xt, yt, labels = txt, family="serif", cex = 1.23)
sw = strwidth(txt)+1.4
sh = strheight(txt) +6
frsz = 0.38
rect(xt - sw/2 - frsz, yt - sh/2 - frsz, xt + sw/2 + frsz, yt + sh/2 + frsz-1)
# legend(15,80, legend = c("High erosion rates in \nwheat-planting years\n"),
       # xjust = 0.5, yjust = 0.5)
dev.off()

Upvotes: 0

Views: 1452

Answers (1)

Kat
Kat

Reputation: 18714

It didn't use base R, but this makes an svg, which is smaller than a jpeg and will create some beautiful images. MS Word has no problems with svg, either. The svg-- 18 kb; the jpeg-- 592 kb for the same image. Use if it works, if not, well, perhaps someone else could use it? This won't show in the plot pane in RStudio, it will show in the viewer pane. After the code, I have an image of saving the plot in the viewer pane in RStudio.

library(plotly)

df = data.frame("Year" = xaxs, "Depth" = precip, "Erosion" = ero *10)

p = plot_ly(df) %>% 
  add_trace(x = ~Year, y = ~Depth, 
            type = 'scatter', mode = 'lines', # to have both the points and lines use 'lines+markers'
            name = "Depth",
            line = list(shape = "spline",     # smooth the curves in the lines (not that effective with lines+markers)
                        color = "green")) %>% 
  add_trace(x = ~Year, y = ~Erosion, 
            mode = 'lines', 
            name = "Erosion",
            yaxis = "y2",                     # second y axis
            line = list(dash = 'dash',        # dash the lines
                        shape = "spline",     # smooth the curves in the lines
                        color = "red")) %>%   # without "lines+markers" spline will smooth out the points of the line
  add_annotations(inherit = F,        # add the arrows at the top of the plot
                  x = list(12, 18),   # this is plot coordinates
                  y = list(800, 800),
                  ax = list(-60, 60), # this is pixels
                  ay = list(10, 10),
                  showarrow = T,
                  text = "") %>% 
  add_annotations(inherit = F,        # add the textbox at the top of the plot
                  x = 15, y = 800,
                  ax = 0, ay = 0,
                  showarrow = F,
                  bordercolor = 'black',
                  text = "High erosion rates in\nwheat-planting years") %>% 
  layout(yaxis2 = list(overlaying = "y", side = "right",  # add labels
                       title = paste0("Erosion (t ", 
                                      "ha<sup>-1</sup>", 
                                      "yr<sup>-1</sup>", 
                                      ")")),
         yaxis = list(title = "Depth (mm)"),
         legend = list(x = .1, y = 1000),
         margin = list(r = 80))         # right margin space for label 

To save it, add the functionality. The icons at the top of the plot in the image at the end won't show until you hover over them. I think you may find that if you use this, the height/width specifications you have aren't the best fit anymore.

(p <- p %>% config(            # save the plot; add a save function to the plot
  toImageButtonOptions = list(
    format = "svg",
    filename = "try",
    width = 950,
    height = 760)) # end config
  ) # end () for print simo object assignment

Save Plotly as SVG

The plot. The width and height in this image are 950 x 550.

the plot

Upvotes: 1

Related Questions