Related
I needed to include in the code below, a vertical line,
for example, in position x = 5 and that all points smaller than 5 have another color,
for example blue.
The values of a variable can be read from the x-axis, and the y-axis shows the order of the observations in the variable (from bottom to top). Isolated points as the far ends, and on either side in a plot, suggest potentional outliers
Thanks
library(dplyr)
library(lattice)
n = 1000
df <- tibble(
xx1 = runif(n, min = 3, max = 10),
xx2 = runif(n, min = 3, max = 10),
xx3 = runif(n, min = 3, max = 10)
)
MyVar <- c("xx1","xx2","xx3")
MydotplotBR <- function(DataSelected){
P <- dotplot(as.matrix(as.matrix(DataSelected)),
groups=FALSE,
strip = strip.custom(bg = 'white',
par.strip.text = list(cex = 1.2)),
scales = list(x = list(relation = "same",tck = 1,
draw = TRUE, at=seq(0,10,1)),x=list(at=seq),
y = list(relation = "free", draw = FALSE),
auto.key = list(x =1)),
col=10,
axes = FALSE,
cex = 0.4, pch = 5,
xlim=c(0,10),
xlab = list(label = "Variable Value", cex = 1.5),
ylab = list(label = "Order of data in the file", cex = 1.5))
print(P)
}
(tempoi <- Sys.time())
Vertemp <- MydotplotBR(df[,MyVar])
(tempof <- Sys.time()-tempoi)
I find it weird that you want a color dependent only on the x-axis when values are also used on the y-axis of other plots.
Nevertheless, here's a homemade pairs_cutoff() function doing what you want.
pairs_cutoff <- function(data, cutoff, cols = c("red", "blue"),
only.lower = F, ...){
data <- as.data.frame(data)
cns <- colnames(data)
nc <- ncol(data)
layout(matrix(seq_len(nc^2), ncol = nc))
invisible(
sapply(seq_len(nc), function(i){
sapply(seq_len(nc), function(j){
if(i == j){
plot.new()
legend("center", bty = "n", title = cns[i], cex = 1.5, text.font = 2, legend = "")
} else {
if(j < i & only.lower)
plot.new()
else{
if(is.null(cutoff))
cols <- cols[1]
plot(data[,i], data[,j], col = cols[(data[,i] < cutoff) + 1],
xlab = cns[i], ylab = cns[j], ...)
}
}
})
})
)
}
Using your suggested data :
n = 1000
dat <- tibble(
xx1 = runif(n, min = 3, max = 10),
xx2 = runif(n, min = 3, max = 10),
xx3 = runif(n, min = 3, max = 10)
)
pairs_cutoff(dat, cutoff = 5, only.lower = T)
outputs the following plot :
You can specify extra parameters to the plot function (eg. pch) directly to pairs_cutoff.
Also, if you want the full symmetric grid of plots, set only.lower = F.
I have an R function that plots some curves stacked on top of each other (see picture below the code).
I was wondering, however, how I could adjust the distance between the curves (see blue arrows) so that the curves don't look so flat?
Also, is it possible to use polygon instead of lines to plot these curves?
stacked = function(a, b, lo, hi, d, Bi = 55, n = 1e2){
h = list()
for(i in 1:length(d)){
p = function(x) get(d[i])(x, a, b)
prior = function(x) p(x)/integrate(p, lo, hi)[[1]]
likelihood = function(x) dbinom(Bi, n, x)
posterior = function(x) prior(x)*likelihood(x)
h[i] = list(curve(posterior, ty = "n", ann = FALSE, yaxt = "n", xaxt = "n", add = i!= 1, bty = "n", n = 1e3))
}
plot(matrix(c(rep(c(.4, .8), each = length(d))), length(d), 2), rep(1:length(d), 2), ty = "n", xlim = 0:1, ann = FALSE, xaxt = "n", ylim = c(1, length(d)+.4))
for(i in 1:length(d)){
lines(h[[i]]$x, h[[i]]$y+i, ty = "l", xpd = NA, col = i)
}
}
# Example of use:
stacked(lo = 0, hi = 1, a = 2, b = 3, d = c("dgamma", "dnorm", "dcauchy", "dbeta", "dlogis", "dweibull"))
You can just scale the y-values before drawing the lines. I have added a scale parameter to your function. Try scale =2 or 3
stacked = function(a, b, lo, hi, d, Bi = 55, n = 1e2, scale=1){
h = list()
for(i in 1:length(d)) {
p = function(x) get(d[i])(x, a, b)
prior = function(x) p(x)/integrate(p, lo, hi)[[1]]
likelihood = function(x) dbinom(Bi, n, x)
posterior = function(x) prior(x)*likelihood(x)
h[i] = list(curve(posterior, ty = "n", ann = FALSE, yaxt = "n", xaxt = "n", add = i!= 1, bty = "n", n = 1e3))
}
plot(matrix(c(rep(c(.4, .8), each = length(d))), length(d), 2), rep(1:length(d), 2), ty = "n", xlim = 0:1, ann = FALSE, xaxt = "n", ylim = c(1, length(d)+.4))
for(i in 1:length(d)){
lines(h[[i]]$x, scale*h[[i]]$y+i, ty = "l", xpd = NA, col = i)
}
}
stacked(lo = 0, hi = 1, a = 2, b = 3, scale=2,
d = c("dgamma", "dnorm", "dcauchy", "dbeta", "dlogis", "dweibull"))
If you wish to fill in the area under the curves, you can use polygon. Change the lines:
for(i in 1:length(d)){
lines(h[[i]]$x, scale*h[[i]]$y+i, ty = "l", xpd = NA, col = i)
}
TO
for(i in 1:length(d)){
polygon(x=h[[i]]$x, y=scale*h[[i]]$y+i, col = i)
}
I'm trying to loop over 2 curves in R but only one of the curves shows. More importantly, I call axis() command two times (for x and y axes) but I get the following error:
Error in axis(1, at = success/trials) : no locations are finite
'to' must be a finite number
Question
I'm wondering (a) why only my first curve is showing and (b) why I'm getting Inf/-Inf in my axis() calls?
Here is my R code:
success = c(10, 50) ; trials = 100
for(i in 1:length(success)){
success = success[i]
col = (1:length(success))[i]
c = curve( dbinom(success, trials, x), 0, 1, add = ifelse(i > 1, T, F), ty = "l", xlim = c(0, 1),
col = col, yaxt = "n")
text(success/trials, max(c$y), bquote(bolditalic(H[.(i)])), pos = 3, xpd = T )
axis(1, at = success/trials)
}
axis(2, at = seq(0, max(c$y), len = 7), labels = round(seq(0, max(c$y), len = 7), 2), las = 1 )
In your first pass through the loop you set success to success[1] and in the second pass through the loop you set success to success[2] but success was at that point length 1, so it becomes NA.
Similarly, the second plot doesn't show because col becomes NA for the same reason.
To fix this, use a different name for the list of successes and the variable in the loop. For example, use successes = c(10,50) and then use successes when setting success and col inside the loop. (Alternatively for col, just set col = i.)
Applying that to your code:
successes = c(10, 50) ; trials = 100
for(i in 1:length(successes)){
success = successes[i]
col = i
c = curve( dbinom(success, trials, x), 0, 1, add = ifelse(i > 1, T, F), ty = "l", xlim = c(0, 1),
col = col, yaxt = "n")
text(success/trials, max(c$y), bquote(bolditalic(H[.(i)])), pos = 3, xpd = T )
axis(1, at = success/trials)
}
axis(2, at = seq(0, max(c$y), len = 7), labels = round(seq(0, max(c$y), len = 7), 2), las = 1 )
I am trying to use twoord.plot with different dates on x axis and counts for ly and percentages for ry, and I want to remove axis 3 or change its color. Setting axes = F does not work, neither does xaxt = 'n'.
In fact, axes = FALSE gives me this error message:
Error in plot.default(lx, ly, xlim = xlim, ylim = lylim, xlab = xlab, :
formal argument "axes" matched by multiple actual arguments
The solution given here:
Remove all axis values and labels in twoord plot does not work for me with different rx and lx.
Here is a similar code to that I'm using:
set.seed(123)
library(plotrix)
twoord.plot(
lx = seq(as.Date("2016-01-01"), as.Date("2017-01-01"), by = "days"),
ly = round(runif(367) * 6),
rx = seq(as.Date("2016-05-09"), as.Date("2017-01-12"), by = "days"),
ry = sort(rnorm(249, 60, 10)),
lylim = range(round(runif(367) * 6)) + c(0, 10),
rylim = range(sort(rnorm(249, 60, 10))) + c(-35, 10),
ylab.at = mean(round(runif(367) * 6)),
rylab.at = mean(sort(rnorm(249, 60, 10))),
rylab = "Percentages %", ylab = "No. of x",
type = c("l", "l"), lcol = "skyblue4", rcol = "chocolate1" ,
xtickpos = as.numeric(seq(as.Date("2016-01-01"), as.Date("2017-01-01"), by = "months")),
xticklab = seq(as.Date("2016-01-01"), as.Date("2017-01-01"), by = "months"))
Any ideas on how to this? Thanks in advance! :)
Just hack the twoord.plot function. Here's an example to make all axis labels black (Use twoord.plot2 instead of twoord.plot when creating the plot). If you want to remove the axes altogether, just comment (add # before the lines) Lines 88-90 (For ly) and Lines 123-125 (for ry). I have left notes for them in the function below.
twoord.plot2 = function (lx, ly, rx, ry, data = NULL, main = "", xlim = NULL,
lylim = NULL, rylim = NULL, mar = c(5, 4, 4, 4), lcol = 1,
rcol = 2, xlab = "", lytickpos = NA, ylab = "", ylab.at = NA,
rytickpos = NA, rylab = "", rylab.at = NA, lpch = 1, rpch = 2,
type = "b", xtickpos = NULL, xticklab = NULL, halfwidth = 0.4,
axislab.cex = 1, do.first = NULL, ...)
{
if (!is.null(data)) {
ly <- unlist(data[ly])
ry <- unlist(data[ry])
if (missing(lx))
lx <- 1:length(ly)
else lx <- unlist(data[lx])
if (missing(rx))
rx <- 1:length(ry)
else rx <- unlist(data[rx])
}
if (missing(lx))
lx <- 1:length(ly)
if (missing(ry)) {
if (missing(rx)) {
rx <- 1:length(ry)
ry <- ly
ly <- lx
lx <- 1:length(ly)
}
else {
ry <- rx
rx <- 1:length(ry)
}
}
oldmar <- par("mar")
par(mar = mar)
if (is.null(xlim))
xlim <- range(c(lx, rx))
if (missing(lx))
lx <- 1:length(ly)
if (is.null(lylim)) {
lylim <- range(ly, na.rm = TRUE)
lyspan <- diff(lylim)
if (lyspan == 0)
lyspan <- lylim[1]
lylim[2] <- lylim[2] + lyspan * 0.04
if (lylim[1] != 0)
lylim[1] <- lylim[1] - lyspan * 0.04
}
if (length(type) < 2)
type <- rep(type, 2)
if (match(type[1], "bar", 0)) {
oldcex <- par(cex = axislab.cex)
plot(lx, ly, xlim = xlim, ylim = lylim, xlab = xlab,
ylab = "", yaxs = "i", type = "n", main = "", axes = FALSE,
...)
par(oldcex)
if (!is.null(do.first))
eval(parse(text = do.first))
ybottom <- par("usr")[3]
if (lylim[1] < 0)
abline(h = 0, lty = 2)
rect(lx - halfwidth, ifelse(ly < 0, ly, ybottom), lx +
halfwidth, ifelse(ly > 0, ly, 0), col = lcol)
}
else {
oldcex <- par(cex = axislab.cex)
plot(lx, ly, xlim = xlim, ylim = lylim, xlab = xlab,
ylab = "", yaxs = "i", type = "n", main = "", axes = FALSE,
...)
par(oldcex)
if (!is.null(do.first))
eval(parse(text = do.first))
points(lx, ly, col = lcol, pch = lpch, type = type[1],
...)
}
title(main = main)
xylim <- par("usr")
box()
if (is.null(xticklab))
axis(1, cex.axis = axislab.cex)
else {
if (is.null(xtickpos))
xtickpos <- 1:length(xticklab)
axis(1, at = xtickpos, labels = xticklab, cex.axis = axislab.cex)
}
if (is.na(lytickpos[1]))
lytickpos <- pretty(ly)
if (is.na(ylab.at))
ylab.at <- mean(lytickpos)
color.axis(2, at = lytickpos, axlab = ylab, axlab.at = ylab.at, #LINE 88
col = "black", cex.axis = axislab.cex, #col = ifelse(is.na(lcol), 1, lcol), cex.axis = axislab.cex,
cex = axislab.cex) #LINE 90
if (is.null(rylim)) {
rylim <- range(ry, na.rm = TRUE)
ryspan <- diff(rylim)
if (ryspan == 0)
ryspan <- rylim[1]
rylim[2] <- rylim[2] + ryspan * 0.04
if (rylim[1] != 0)
rylim[1] <- rylim[1] - ryspan * 0.04
}
ymult <- diff(lylim)/diff(rylim)
yoff <- lylim[1] - rylim[1] * ymult
if (match(type[2], "bar", 0)) {
if (rylim[1] < 0)
abline("h", 0)
rect(rx - halfwidth, ifelse(ry < 0, ry, rylim[1] * ymult +
yoff), rx + halfwidth, ifelse(ry > 0, ry * ymult +
yoff, 0), col = rcol)
}
else points(rx, ry * ymult + yoff, col = rcol, pch = rpch,
type = type[2], ...)
if (is.na(rytickpos[1]))
rylabels <- pretty(rylim)
else rylabels <- rytickpos
if (min(rylabels) < rylim[1])
rylabels <- rylabels[rylabels >= rylim[1]]
if (max(rylabels) > rylim[2])
rylabels <- rylabels[rylabels <= rylim[2]]
axat <- rylabels * ymult + yoff
if (is.na(rylab.at))
rylab.at <- mean(rytickpos)
if (!is.na(rylab.at))
rylab.at <- rylab.at * ymult + yoff
color.axis(4, at = axat, labels = rylabels, axlab = rylab, #LINE 123
axlab.at = rylab.at, col = "black", #axlab.at = rylab.at, col = ifelse(is.na(rcol), 1, rcol),
cex.axis = axislab.cex, cex = axislab.cex) #LINE 125
par(mar = oldmar, new = FALSE, col.axis = "black")
}
I've been working on a HTML document with Rmarkdown.
The document has several sp plots and ggplots and all of them appear in the HTML.
But when I call plotK (which is a function from stpp package to plot the spatio-temporal inhomogeneous k-funtion - STIKhat), the plot doesnt appear in the HTML.
Here's a reproducible example for Rmarkdown:
---
title: "Untitled"
output: html_document
---
```{r}
library(stpp)
data(fmd)
data(northcumbria)
FMD<-as.3dpoints(fmd[,1]/1000,fmd[,2]/1000,fmd[,3])
Northcumbria=northcumbria/1000
# estimation of the temporal intensity
Mt<-density(FMD[,3],n=1000)
mut<-Mt$y[findInterval(FMD[,3],Mt$x)]*dim(FMD)[1]
# estimation of the spatial intensity
h<-mse2d(as.points(FMD[,1:2]), Northcumbria, nsmse=50, range=4)
h<-h$h[which.min(h$mse)]
Ms<-kernel2d(as.points(FMD[,1:2]), Northcumbria, h, nx=5000, ny=5000)
atx<-findInterval(x=FMD[,1],vec=Ms$x)
aty<-findInterval(x=FMD[,2],vec=Ms$y)
mhat<-NULL
for(i in 1:length(atx)) mhat<-c(mhat,Ms$z[atx[i],aty[i]])
# estimation of the STIK function
u <- seq(0,10,by=1)
v <- seq(0,15,by=1)
stik1 <- STIKhat(xyt=FMD, s.region=northcumbria/1000,t.region=c(1,200),
lambda=mhat*mut/dim(FMD)[1], dist=u, times=v, infectious=TRUE)
```
```{r}
plotK(stik1)
```
after knitting, the plot doesnt appear in HTML. Does anyone has some idea what is going on?
Thank you so much!
This question is a little stale, but I couldn't help but take #ryanm comment (that I just noticed) as a fun challenge. As I mentioned in the comment above, the problem lies in how the plotK function is manipulating devices. Some trimming of (unnecessary?) code in the plotK function solves the problem:
---
title: "Untitled"
output: html_document
---
```{r}
library(stpp)
data(fmd)
data(northcumbria)
FMD<-as.3dpoints(fmd[,1]/1000,fmd[,2]/1000,fmd[,3])
Northcumbria=northcumbria/1000
# estimation of the temporal intensity
Mt<-density(FMD[,3],n=1000)
mut<-Mt$y[findInterval(FMD[,3],Mt$x)]*dim(FMD)[1]
# estimation of the spatial intensity
h<-mse2d(as.points(FMD[,1:2]), Northcumbria, nsmse=50, range=4)
h<-h$h[which.min(h$mse)]
Ms<-kernel2d(as.points(FMD[,1:2]), Northcumbria, h, nx=5000, ny=5000)
atx<-findInterval(x=FMD[,1],vec=Ms$x)
aty<-findInterval(x=FMD[,2],vec=Ms$y)
mhat<-NULL
for(i in 1:length(atx)) mhat<-c(mhat,Ms$z[atx[i],aty[i]])
# estimation of the STIK function
u <- seq(0,10,by=1)
v <- seq(0,15,by=1)
stik1 <- STIKhat(xyt=FMD, s.region=northcumbria/1000,t.region=c(1,200),
lambda=mhat*mut/dim(FMD)[1], dist=u, times=v, infectious=TRUE)
```
```{r,echo=FALSE}
plotK <- function (K, n = 15, L = FALSE, type = "contour", legend = TRUE,
which = NULL, main = NULL, ...)
{
old.par <- par(no.readonly = TRUE)
on.exit(par(old.par))
correc = c("none", "isotropic", "border", "modified.border",
"translate")
correc2 = K$correction
id <- match(correc2, correc, nomatch = NA)
if ((is.null(which) && length(id) > 1) || any(is.na(match(which,
correc, nomatch = NA)))) {
mess <- paste("Please specify the argument 'which', among:",
paste(dQuote(correc2), collapse = ", "))
stop(mess, call. = FALSE)
}
if (isTRUE(K$infectious))
which = "isotropic"
if (is.matrix(K$Khat)) {
if (is.null(which))
which = correc2
else {
if (!(is.null(which)) && which != correc2) {
mess <- paste("Argument 'which' should be", paste(dQuote(correc2),
collapse = ", "))
stop(mess, call. = FALSE)
}
}
}
if (!is.matrix(K$Khat)) {
id <- match(which, correc2, nomatch = NA)
if (is.na(id)) {
mess <- paste("Please specify the argument 'which', among:",
paste(dQuote(correc2), collapse = ", "))
stop(mess, call. = FALSE)
}
else K$Khat = K$Khat[[id]]
}
if (!is.null(main)) {
titl = main
subtitl = ""
if (isTRUE(L))
k <- K$Khat - K$Ktheo
else k <- K$Khat
}
else {
if (isTRUE(L)) {
k <- K$Khat - K$Ktheo
subtitl <- paste("edge correction method: ", which,
sep = "")
if (isTRUE(K$infectious))
titl <- expression(hat(K)[ST] * group("(", list(u,
v), ")") - pi * u^2 * v)
else titl <- expression(hat(K)[ST] * group("(", list(u,
v), ")") - 2 * pi * u^2 * v)
}
else {
k <- K$Khat
titl = expression(hat(K)[ST] * group("(", list(u,
v), ")"))
subtitl <- paste("edge correction method: ", which,
sep = "")
}
}
typeplot = c("contour", "image", "persp")
id <- match(type, typeplot, nomatch = NA)
if (any(nbg <- is.na(id))) {
mess <- paste("unrecognised plot type:", paste(dQuote(type[nbg]),
collapse = ", "))
stop(mess, call. = FALSE)
}
if ((length(id) != 1) || is.na(id))
stop("Please specify one type among \"contour\", \"image\" and \"persp\" ")
typeplot = rep(0, 3)
typeplot[id] = 1
colo <- colorRampPalette(c("red", "white", "blue"))
M <- max(abs(range(k)))
M <- pretty(c(-M, M), n = n)
n <- length(M)
COL <- colo(n)
if (typeplot[3] == 1) {
mask <- matrix(0, ncol = length(K$times), nrow = length(K$dist))
for (i in 1:length(K$dist)) {
for (j in 1:length(K$times)) {
mask[i, j] <- COL[findInterval(x = k[i, j], vec = M)]
}
}
COL <- mask[1:(length(K$dist) - 1), 1:(length(K$times) -
1)]
if (isTRUE(legend)) {
par(cex.lab = 2, cex.axis = 1.5, font = 2, lwd = 1,
mar = c(0, 0, 3, 0))
par(fig = c(0, 0.825, 0, 1))
persp(x = K$dist, y = K$times, z = k, xlab = "u",
ylab = "v", zlab = "", expand = 1, col = COL,
...)
title(titl, cex.main = 1.5, sub = subtitl, outer = TRUE,
line = -1)
par(fig = c(0.825, 1, 0, 1))
mini <- findInterval(x = min(k, na.rm = TRUE), vec = M)
maxi <- findInterval(x = max(k, na.rm = TRUE), vec = M)
legend("right", fill = colo(n)[maxi:mini], legend = M[maxi:mini],
horiz = F, bty = "n")
}
else {
par(cex.lab = 2, cex.axis = 1.5, font = 2, lwd = 1)
persp(x = K$dist, y = K$times, z = k, xlab = "u",
ylab = "v", zlab = "", expand = 1, col = COL,
...)
title(titl, cex.main = 1.5, sub = subtitl)
}
}
if (typeplot[1] == 1) {
if (isTRUE(legend)) {
par(cex.lab = 1.5, cex.axis = 1.5, font = 2, plt = c(0,
1, 0, 1), lwd = 1, mar = c(0.5, 0.5, 2.5, 0.5),
las = 1)
par(fig = c(0.1, 0.825, 0.1, 1))
contour(K$dist, K$times, k, labcex = 1.5, levels = M,
drawlabels = F, col = colo(n), zlim = range(M),
axes = F)
box(lwd = 2)
at <- axTicks(1)
axis(1, at = at[1:length(at)], labels = at[1:length(at)])
at <- axTicks(2)
axis(2, at = at[1:length(at)], labels = at[1:length(at)])
title(titl, cex.main = 1.5, sub = subtitl, outer = TRUE,
line = -1)
par(fig = c(0, 1, 0.1, 1))
mini <- findInterval(x = min(k, na.rm = TRUE), vec = M)
maxi <- findInterval(x = max(k, na.rm = TRUE), vec = M)
legend("right", fill = colo(n)[maxi:mini], legend = M[maxi:mini],
horiz = F, bty = "n")
}
else {
par(cex.lab = 2, cex.axis = 1.5, font = 2, lwd = 2,
las = 1)
contour(K$dist, K$times, k, labcex = 1.5, levels = M,
drawlabels = T, col = colo(n), zlim = range(M),
axes = F)
box(lwd = 2)
at <- axTicks(1)
axis(1, at = at[1:length(at)], labels = at[1:length(at)])
at <- axTicks(2)
axis(2, at = at[1:length(at)], labels = at[1:length(at)])
title(titl, cex.main = 1.5, sub = subtitl)
}
}
if (typeplot[2] == 1) {
if (isTRUE(legend)) {
par(cex.lab = 1.5, cex.axis = 1.5, font = 2, lwd = 1,
plt = c(0, 1, 0, 1), mar = c(0.5, 0.5, 2.5, 0.5),
las = 1)
par(fig = c(0.1, 0.825, 0.1, 1))
image(K$dist, K$times, k, col = colo(n), zlim = range(M),
axes = F, xlab = "", ylab = "")
box(lwd = 2)
at <- axTicks(1)
axis(1, at = at[1:length(at)], labels = at[1:length(at)])
at <- axTicks(2)
axis(2, at = at[1:length(at)], labels = at[1:length(at)])
title(titl, cex.main = 1.5, sub = subtitl, outer = TRUE,
line = -1)
par(fig = c(0, 1, 0.1, 1))
mini <- findInterval(x = min(k, na.rm = TRUE), vec = M)
maxi <- findInterval(x = max(k, na.rm = TRUE), vec = M)
legend("right", fill = colo(n)[maxi:mini], legend = M[maxi:mini],
horiz = F, bty = "n")
}
else {
par(cex.lab = 2, cex.axis = 1.5, font = 2, lwd = 2,
las = 1)
image(K$dist, K$times, k, col = colo(n), zlim = range(M),
axes = F, xlab = "", ylab = "")
box(lwd = 2)
at <- axTicks(1)
axis(1, at = at[1:length(at)], labels = at[1:length(at)])
at <- axTicks(2)
axis(2, at = at[1:length(at)], labels = at[1:length(at)])
title(titl, cex.main = 1.5, sub = subtitl)
}
}
par(old.par)
}
```
```{r}
plotK(stik1)
```
If you use the stpp package often, it might be worth an e-mail to the maintainer about why messing with the device is necessary.
Try this with some extra packages in your plotting chunk:
library(png)
library(grid)
library(gridExtra)
plotK(stik1)
dev.print(png, "plot.png", width=480, height=480)
img <- readPNG("plot.png")
img <- rasterGrob(img)
grid.draw(img)