Contour and Perspective Plot Error for Kernel Density Estimation - r

So I would like to do a kernel density estimation and output both a contour and perspective plot. I am extremely close to figuring out the contour plot but I have hit an error when I run the code below. Additionally, the code I find online does not seem to work for my dataset in regard to a perspective plot for this same data. I am doing this with a bandwidth of .5,.5 .
countourist<- ggplot(df, aes(x = X, y = Y)) +
geom_point() +
xlim(-5, 5) +
ylim(-5, 5)
countourist + stat_density_2d(aes(fill = stat(level)),
countour = TRUE, h = .5,.5,
geom = "polygon")
Sample Data:
structure(list(X = c(-0.0962590773067708, -1.18915207404317,
0.706207022991542, 0.354207143877577, -0.81518898552579, 0.275541521081109,
0.497855536939137, 0.645414156351502, -0.0122766542233017, 0.40578545233698,
0.189360054285873, 0.253754051773016, -0.88127350804621, 0.485445084008632,
0.276018362443043, 0.0145802591922327, -0.181071537886075, 0.121463173714344,
-0.152709201805671, -0.338877208521439, -1.46948728986613, -2.02398725046067,
-0.624336281672069, -1.62555577656191, -0.67130590447829, -0.0335257471517457,
0.198179809536955, -0.63029273337944, -0.694460643800555, -0.411059118662514,
0.221464974231996, 0.430316124954996, -1.6217665981342, -0.881526856414648,
-1.3192875841495, 0.404600053659747, 1.12817344490934, 0.024248421312024,
-0.399749792485403, 0.0857939068657727, -0.217844669409035, 0.101279872558566,
0.291323502766035, -1.42132579845577, 1.2753388274467, -1.33076195534297,
-1.46502902788164, -0.73855874296236, -1.0322620171297, 0.113170727116302
), Y = c(0.0632600046556984, -1.78280440755007, 2.82492518636035,
1.68999775891935, -1.40182480306009, -0.0162214629216463, 1.00914182163537,
0.258321598714745, 0.249412178294172, 0.505938493454907, 0.88745904296611,
0.545487039522648, 0.205393499236483, 1.43415169211384, -0.0293576589272771,
0.373169713548136, 0.462176118409707, -1.11661047785449, 0.0361289986559508,
0.219314070361257, -1.72970101801671, -1.13555829290375, -0.257332488904325,
-1.00336683254877, -2.24667782853137, 0.718672747346788, 0.381256786447137,
-0.0897024758439116, 0.533411392798842, 0.712575478035058, 1.6809613554424,
0.504565244422453, -0.0852144876427054, 0.229922323383187, 0.0269379632874171,
0.644533564497338, 1.49725854460476, 0.382307653466023, -0.41280923134344,
-0.666316793613442, 0.410058708890068, -0.354068636380733, 1.55419054704138,
-1.0573192227978, 1.48806834104077, -1.57278080268752, -0.863516432481153,
-0.908568905792217, -1.30139200592853, 0.896154050079126)), row.names = c(NA,
-50L), class = c("tbl_df", "tbl", "data.frame"))

Related

loess() doesn't smooth subsequently but over pooled data

I have time-series of 2d obsverations that I'm trying to smooth to take out some of the observation variability. I've been applying loess(), but just noticed it doesn't seem to smooth as a function of time but just across the entire pooled coordinates. Am I missing something? Is there a different function I should be using?
df<-structure(list(timestamp = structure(c(1586488380, 1586488440,
1586488560, 1586488620, 1586488680, 1586488740, 1586488800, 1586488860,
1586489520, 1586489580, 1586489700, 1586489820, 1586489880, 1586489940,
1586490000, 1586490060, 1586490120, 1586490180, 1586490240, 1586490300,
1586490360, 1586490420, 1586490480, 1586490540, 1586490600, 1586490660,
1586490720, 1586490780, 1586490840, 1586490900, 1586490960, 1586491020,
1586491200, 1586491260, 1586491320, 1586491380, 1586491440, 1586491500,
1586491560, 1586491620, 1586491680, 1586491740, 1586491800, 1586491860,
1586491920, 1586491980, 1586492040, 1586492100, 1586492160, 1586492220,
1586492280, 1586492340, 1586492400, 1586492460, 1586492520, 1586492580,
1586492640, 1586492700, 1586492760, 1586492820, 1586492880, 1586492940,
1586493000, 1586493060, 1586493120, 1586493180, 1586493240, 1586493300,
1586493360, 1586493420, 1586493480, 1586493540, 1586493600, 1586493660,
1586493720, 1586493780, 1586493840, 1586493900, 1586493960, 1586494020,
1586494200, 1586494260, 1586494320, 1586494380, 1586494440, 1586494500,
1586494560, 1586494620, 1586494680, 1586494740, 1586494800, 1586494860,
1586494920, 1586494980, 1586495040, 1586495100, 1586495160, 1586495220,
1586495280, 1586495340, 1586495400, 1586495460, 1586495520, 1586495580,
1586495640, 1586495700, 1586495760, 1586495820, 1586495880, 1586495940,
1586496000, 1586496060, 1586496120, 1586496180, 1586496240, 1586496300,
1586496360, 1586496420, 1586496480, 1586496540, 1586496600, 1586496660,
1586496720, 1586496780, 1586496840, 1586496900, 1586496960, 1586497020,
1586497080, 1586497140, 1586497200, 1586497260, 1586497320, 1586497380,
1586497440, 1586497500, 1586497560, 1586497620, 1586497680, 1586497740,
1586497800, 1586497860, 1586497920, 1586497980, 1586498040, 1586498100,
1586498160, 1586498220, 1586498280, 1586498340), class = c("POSIXct",
"POSIXt"), tzone = "UTC"), easting = c(740.582355718548, 740.582355718548,
739.726374785548, 739.611045841548, 739.508690311548, 739.398269506548,
739.278804356548, 739.627760514548, 737.913640733548, 738.088450601548,
738.551491861548, 738.957133488548, 739.137345557548, 739.304664573548,
739.460440784548, 739.605842807548, 739.741887116548, 739.719077482548,
739.369420509548, 738.973489249548, 738.521335985548, 739.279305656548,
739.993757669548, 740.085239162548, 740.172262825548, 740.255157063548,
740.334219013548, 740.409718260548, 740.481900024548, 740.550987811548,
740.573883125548, 740.252267406548, 739.261723439548, 738.935233921548,
738.774921432548, 738.615895069548, 738.451107559548, 738.280235586548,
738.493740162548, 738.717501067548, 738.925752666548, 739.120074872548,
739.301840012548, 739.472245999548, 739.632343117548, 739.890965132548,
740.098495936548, 740.293354354548, 740.476683179548, 740.649491986548,
740.678160672548, 740.443560695548, 740.398855065548, 740.451032168548,
740.467918582548, 740.160041067548, 739.819912921548, 739.641686751548,
739.457020461548, 739.265544595548, 739.193281488548, 739.227252654548,
738.995761471548, 738.822890745548, 738.775446949548, 738.726816309548,
738.676941805548, 738.625762928548, 739.254178659548, 739.727445331548,
740.019566884548, 740.129316037548, 740.255273807548, 740.442527947548,
740.615257127548, 740.775140223548, 740.923607252548, 741.055065964548,
741.139279130548, 740.907234314548, 739.290829342548, 739.115359714548,
740.664354207548, 740.589899151548, 740.578913554548, 740.571708783548,
740.568311076548, 740.568740893548, 740.527920123548, 740.358565457548,
740.392277156548, 740.370981239548, 740.289917518548, 740.214089159548,
740.192635592548, 740.176850935548, 740.160315351548, 740.143068630548,
740.103174446548, 740.008327647548, 740.058271768548, 740.205384482548,
740.211048172548, 740.150159818548, 740.122028309548, 740.230164637548,
740.271076846548, 740.075087486548, 739.768752873548, 739.586722485548,
739.940259334548, 740.233576255548, 740.473614136548, 740.495703912548,
740.341935547548, 740.186820856548, 740.204435025548, 740.299218490548,
740.318343269548, 740.238895133548, 739.999671854548, 740.062183564548,
740.196345466548, 740.329697802548, 740.418193609548, 740.311257937548,
740.270203214548, 740.209679752548, 740.146590442548, 740.079785501548,
740.170176300548, 740.268945921548, 740.217498771548, 740.133923060548,
740.117921377548, 740.177771453548, 740.140658663548, 740.080204534548,
740.108449333548, 740.145621912548, 740.182429420548, 740.010376475548,
739.819150336548, 739.616854492548, 739.369690457548, 739.104183601548,
738.938020260548, 738.843359187548, 738.802644324548, 738.761524527548
), northing = c(2307.15134120986, 2307.15134120986, 2307.60836846986,
2307.72110371186, 2307.83015111886, 2307.94605545486, 2308.06963872386,
2307.94323643186, 2308.11539257586, 2307.98516105286, 2307.67209087786,
2307.39795736686, 2307.27544716286, 2307.16124100486, 2307.05447137086,
2306.95438746086, 2306.86033624586, 2306.85049579286, 2307.02449397686,
2307.22230535086, 2307.44905018086, 2306.99878407786, 2306.57790074586,
2306.51052483586, 2306.44607531386, 2306.38433869586, 2306.32512182186,
2306.26824947086, 2306.21356227886, 2306.16091500786, 2306.12077142386,
2306.17964098286, 2306.35042514386, 2306.42512419786, 2306.46180283886,
2306.49818722086, 2306.53588972286, 2306.57498431686, 2306.47587680786,
2306.37665531786, 2306.28431106486, 2306.19814347186, 2306.11754401386,
2306.04198150286, 2305.97099021786, 2305.88981694586, 2305.83737042086,
2305.78847203986, 2305.74280289286, 2305.70008126986, 2305.72436278986,
2305.79211047386, 2305.75001607586, 2305.66373079386, 2305.59454921786,
2305.66723079486, 2305.74826733386, 2305.75631243686, 2305.76412484986,
2305.77169383886, 2305.76318962486, 2305.74988901286, 2305.84052390686,
2305.91140100786, 2305.95786180686, 2306.00518488486, 2306.05340722986,
2306.10256811686, 2305.87083530186, 2305.67745118186, 2305.55808577486,
2305.51324056486, 2305.46177226186, 2305.38525730986, 2305.31467748186,
2305.24934676386, 2305.18868082786, 2305.13496475486, 2305.08628958686,
2305.07937405386, 2305.33244795286, 2305.26640414086, 2304.97847050686,
2304.88865807586, 2304.78121096686, 2304.67333694586, 2304.56517670086,
2304.45687199986, 2304.26299422086, 2303.81398617786, 2303.81772073686,
2303.82576399386, 2303.82937144386, 2303.85166918186, 2303.85679798586,
2303.85841996086, 2303.85934299186, 2303.85962745886, 2303.81418344986,
2303.71268455886, 2303.70396413486, 2303.71187848686, 2303.71241867586,
2303.72409686386, 2303.75626565486, 2303.81432053886, 2303.80604508386,
2303.57280991386, 2303.21896587386, 2303.06912105986, 2303.28351126486,
2303.45378473786, 2303.49375232686, 2303.50460433986, 2303.48302188886,
2303.48174695086, 2303.52692291386, 2303.61686633486, 2303.41139580686,
2303.32679365886, 2303.06984393086, 2303.15017783486, 2303.29293566086,
2303.44528532286, 2303.48203523086, 2302.89274879786, 2302.81440275486,
2302.73512963586, 2302.65410710886, 2302.56757728186, 2302.77320543086,
2303.00846800486, 2303.01932301786, 2302.97477011386, 2303.03742546386,
2303.13970331386, 2303.07628123386, 2302.97297111586, 2303.02123867886,
2303.08476293486, 2303.14766331986, 2303.17026860886, 2303.18249014186,
2303.19025912386, 2303.15218828686, 2303.11064943486, 2302.98849464786,
2302.87632040886, 2302.82807292386, 2302.77934558786)), row.names = 5905:6054, class = "data.frame")
df.fitted<-loess(northing ~ easting, span = .5, data = df)
df$northing.fitted<-df.fitted$fitted
ggplot(df, aes(x=easting,y=northing)) +
geom_path(color='orangered2') +
geom_point(aes(y=northing.fitted))
So, instead of smoothing the "cluster", I'd like to use a rolling average smoothing each x/y pair as a function of time.

You need to regress both easting and northing as functions of time to get smoother x, y values:
df$numtime <- as.numeric(df$timestamp)
df.fitted.northing <-loess(northing ~ numtime, span = .5, data = df)
df.fitted.easting <- loess(easting ~ numtime, span = .5, data = df)
newdat <- data.frame(numtime = seq(min(df$numtime), max(df$numtime), len = 1000))
newdat$northing <- predict(df.fitted.northing, newdat)
newdat$easting <- predict(df.fitted.easting, newdat)
ggplot(df, aes(easting, northing)) +
geom_path(aes(color = "original path"), alpha = 0.6, size = 0.5,
arrow = arrow(length = unit(0.1, "inches"))) +
geom_point(aes(color = "original path"), alpha = 0.6, size = 1) +
geom_path(data = newdat, size = 1, aes(color = "smoothed"),
arrow = arrow(length = unit(0.1, "inches"))) +
coord_equal() +
theme_light() +
scale_color_manual(values = c("original path" = "orangered2",
"smoothed" = "deepskyblue4"), name = "")

how to print some regression info on a figure

I have a data like this
df<- structure(list(How = c(3.1e-05, 0.000114, 0.000417, 0.00153,
0.00561, 0.0206, 0.0754, 0.277, 1.01, 3.72), Where = c(1, 0.948118156866697,
0.920303987764611, 1.03610743904536, 1.08332987533419, 0.960086785898477,
0.765642506120658, 0.572520170014998, 0.375835106792894, 0.254180720963181
)), class = "data.frame", row.names = c(NA, -10L))
library(drc)
I make my model like this
fit <- drm(formula = Where ~ How, data = df,
fct = LL.4(names=c("Slope","Lower Limit","Upper Limit", "EC50")))
Then I plot it like this
plot(NULL, xlim = c(0.000001, 4), ylim = c(0.01, 1.2),log = "x")
points(df$How, df$Where, pch = 20)
x1 = seq(0.000001, 4, by=0.0001)
y1 = coef(fit)[3] + (coef(fit)[2] - coef(fit)[3])/(1+(x1/coef(fit)[4])^((-1)*coef(fit)[1]))
lines(x1,y1)
Now I want to be able to print the following information inside the figure
max(df$How)
min(df$How)
coef(fit)[2]
coef(fit)[3]
(-1)*coef(fit)[1]
coef(fit)[4]
I tried to do it like this
text(labels = bquote(FirstT~"="~.(round(max(df$How)))))
text(labels = bquote(SecondT~"="~.(round(min(df$How))))
text(labels = bquote(A[min]~"="~.(round(coef(fit)[2]))))
text(labels = bquote(A[max]~"="~.(coef(fit)[3]))))
text(labels = paste0("Slope = ", round((-1)*coef(fit)[1])))
which of course does not work. I am more into an automatic way to find a place in right left corner of the figure that print these info

In the code below, we get the plot area coordinate ranges with par("usr") and then use those and the data point locations to automatically place the labels in the desired locations.
# Reduce margins
par(mar=c(5,4,0.5,0.5))
# Get extreme coordinates of plot area
p = par("usr")
p[1:2] = 10^p[1:2] # Because xscale is logged
text(max(df$How), df$Where[which.max(df$How)],
labels = bquote(FirstT~"="~.(round(max(df$How)))), pos=1)
text(min(df$How), df$Where[which.min(df$How)],
labels = bquote(SecondT~"="~.(round(min(df$How)))), pos=1)
text(1.1*p[1], p[3] + 0.02*diff(p[3:4]),
labels = bquote(A[min]~"="~.(round(coef(fit)[2]))), adj=c(0,0))

plot(var()) displays two different plots, how do I merge them into one? Also having two y axis

> dput(head(inputData))
structure(list(Date = c("2018:07:00", "2018:06:00", "2018:05:00",
"2018:04:00", "2018:03:00", "2018:02:00"), IIP = c(125.8, 127.5,
129.7, 122.6, 140.3, 127.4), CPI = c(139.8, 138.5, 137.8, 137.1,
136.5, 136.4), `Term Spread` = c(1.580025, 1.89438, 2.020112,
1.899074, 1.470544, 1.776862), RealMoney = c(142713.9916, 140728.6495,
140032.2762, 139845.5215, 139816.4682, 139625.865), NSE50 = c(10991.15682,
10742.97381, 10664.44773, 10472.93333, 10232.61842, 10533.10526
), CallMoneyRate = c(6.161175, 6.10112, 5.912088, 5.902226, 5.949956,
5.925538), STCreditSpread = c(-0.4977, -0.3619, 0.4923, 0.1592,
0.3819, -0.1363)), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
I want to make my autoregressive plot like this plot:
#------> importing all libraries
library(readr)
install.packages("lubridtae")
library("lubridate")
install.packages("forecast")
library('ggplot2')
library('fpp')
library('forecast')
library('tseries')
#--------->reading data
inputData <- read_csv("C:/Users/sanat/Downloads/exercise_1.csv")
#--------->calculating the lag=1 for NSE50
diff_NSE50<-(diff(inputData$NSE50, lag = 1, differences = 1)/lag(inputData$NSE50))
diff_RealM2<-(diff(inputData$RealMoney, lag = 1, differences = 1)/lag(inputData$RealMoney))
plot.ts(diff_NSE50)
#--------->
lm_fit = dynlm(IIP ~ CallMoneyRate + STCreditSpread + diff_NSE50 + diff_RealM2, data = inputData)
summary(lm_fit)
#--------->
inputData_ts = ts(inputData, frequency = 12, start = 2012)
#--------->area of my doubt is here
VAR_data <- window(ts.union(ts(inputData$IIP), ts(inputData$CallMoneyRate)))
VAR_est <- VAR(y = VAR_data, p = 12)
plot(VAR_est)
I want to my plots to get plotted together in same plot. How do I serparate the var() plots to two separate ones.
Current plot:
My dataset :
dataset

Okay, so this still needs some work, but it should set the right framework for you. I would look more into working with the ggplot2 for future.
Few extra packages needed, namely library(vars) and library(dynlm).
Starting from,
VAR_est <- VAR(y = VAR_data, p = 12)
Now we extract the values we want from the VAR_est object.
y <- as.numeric(VAR_est$y[,1])
z <- as.numeric(VAR_est$y[,2])
x <- 1:length(y)
## second data set on a very different scale
par(mar = c(5, 4, 4, 4) + 0.3) # Leave space for z axis
plot(x, y, type = "l") # first plot
par(new = TRUE)
plot(x, z, type = "l", axes = FALSE, bty = "n", xlab = "", ylab = "")
axis(side=4, at = pretty(range(z)))
mtext("z", side=4, line=3)
I will leave you to add the dotted lines on etc...
Hint: Decompose the VAR_est object, for example, VAR_est$datamat, then see which bit of data corresponds to the part of the plot you want.
Used some of this

Override x axis scale

I've run a spline through some points from a regression and I would like to plot them with ggplot2 where the x scale are years, but I'm not sure how to do this.
How would I override the x-scale to go from 1920-1950?
Data:
df <- structure(list(x = 1:200, y = c(0.00122973667762024, 6.62098801946071e-05,
-0.000959979058174531, -0.00185343528846307, -0.00261876396164689,
-0.0032605702287019, -0.00378345924060399, -0.00419203614832906,
-0.00449090610285299, -0.00468467425515169, -0.00477794575620104,
-0.00477532575697695, -0.0046814194084553, -0.00450083186161199,
-0.00423816826742291, -0.00389803377686397, -0.00348503354091104,
-0.00300377271054004, -0.00245885643672684, -0.00185488987044735,
-0.00119647878632586, -0.000489056540407894, 0.000259484465636334,
0.00104079719045607, 0.00184653459270055, 0.00266834963101903,
0.00349789526406075, 0.00432682445047494, 0.00514679014891087,
0.00594944531801776, 0.00672644291644486, 0.00746943590284142,
0.00817007723585667, 0.00882001987413988, 0.00941091677634026,
0.00993442090110708, 0.0103821852070896, 0.010745862652937, 0.0110171061972986,
0.0111875687988235, 0.011248928362097, 0.0111981513301005, 0.0110440035734643,
0.0107968475027119, 0.010467045528367, 0.010064960060953, 0.00960095351099359,
0.00908538828901222, 0.00852862680553249, 0.00794103147107794,
0.00733296469617213, 0.00671478889133861, 0.00609686646710094,
0.00548955983398266, 0.00490323140250733, 0.00434824358319851,
0.00383495878657975, 0.00337373942317461, 0.00297494790350662,
0.00264894663809936, 0.00240601257949406, 0.00224981076448868,
0.00217279857375538, 0.00216634775507979, 0.00222183005624753,
0.00233061722504423, 0.00248408100925552, 0.00267359315666704,
0.00289052541506439, 0.00312624953223322, 0.00337213725595915,
0.00361956033402782, 0.00385989051422484, 0.00408449954433585,
0.00428475917214646, 0.00445204114544233, 0.00457771721200906,
0.00465315911963229, 0.00466973861609765, 0.00461882744919076,
0.00449196986691963, 0.0042874160634374, 0.00401212749412751,
0.00367364780262395, 0.0032795206325607, 0.00283728962757174,
0.00235449843129108, 0.00183869068735268, 0.00129741003939055,
0.000738200131038661, 0.000168604605931003, -0.000403832892298435,
-0.000971568720015669, -0.00152705923358671, -0.00206276078937758,
-0.00257112974375428, -0.00304462245308283, -0.00347569527372924,
-0.00385680456205953, -0.00418040667443971, -0.00443922939659004,
-0.00463224338937841, -0.00476466218882034, -0.00484197076028562,
-0.00486965406914401, -0.00485319708076528, -0.00479808476051921,
-0.00470980207377557, -0.00459383398590413, -0.00445566546227465,
-0.00430078146825693, -0.00413466696922072, -0.00396280693053579,
-0.00379068631757193, -0.00362379009569889, -0.00346760323028646,
-0.00332761068670441, -0.0032092974303225, -0.00311814842651051,
-0.00305964864063822, -0.00303897089201381, -0.00305661736998701,
-0.00310949480371679, -0.00319441743464015, -0.00330819950419407,
-0.00344765525381556, -0.00360959892494162, -0.00379084475900925,
-0.00398820699745545, -0.00419849988171722, -0.00441853765323156,
-0.00464513455343546, -0.00487510482376593, -0.00510526270565997,
-0.00533242244055458, -0.00555339826988675, -0.00576500443509349,
-0.00596405517761179, -0.00614736473887866, -0.00631174736033109,
-0.00645423379806727, -0.00657409002222406, -0.00667190065928587,
-0.00674826737916529, -0.00680379185177487, -0.00683907574702718,
-0.0068547207348348, -0.0068513284851103, -0.00682950066776623,
-0.00678983895271517, -0.00673294500986969, -0.00665942050914235,
-0.00656986712044573, -0.00646488651369238, -0.00634508035879489,
-0.00621105032566582, -0.00606339808421773, -0.0059027253043632,
-0.00572963365601479, -0.00554472480908507, -0.0053486844807736,
-0.00514281955026036, -0.00492871530336347, -0.00470795833913992,
-0.0044821352566467, -0.0042528326549408, -0.0040216371330792,
-0.0037901352901189, -0.00355991372511687, -0.00333255903713012,
-0.00310965782521562, -0.00289279668843038, -0.00268356222583137,
-0.00248354103647558, -0.00229431971942, -0.00211748487372163,
-0.00195462309843743, -0.00180732099262442, -0.00167716515533957,
-0.00156574218563988, -0.00147461474880411, -0.00140521605759051,
-0.00135893575805815, -0.00133716346343512, -0.00134128878694955,
-0.00137270134182952, -0.00143279074130315, -0.00152294659859854,
-0.0016445585269438, -0.00179901613956701, -0.00198770904969631,
-0.00221202687055977, -0.00247335921538553, -0.00277309569740165,
-0.00311262592983628, -0.00349333952591749, -0.00391662609887341,
-0.00438387526193212, -0.00489647662832175, -0.00545581981127037
)), .Names = c("x", "y"), row.names = c(NA, -200L), class = "data.frame")
I've tried this, but no luck:
ggplot(df, aes(x = x, y = y)) + geom_line() + scale_x_discrete(breaks = 1:31, labels = seq(1920,1950))

You can use tidyr::seq_range() for this
library(ggplot2)
library(tidyr)
df$x <- seq_range(1920:1950,dim(df)[1])
ggplot(df, aes(x = x, y = y) ) + geom_line()

Adding parameters to a ggplot produced plot in a function

Let's say I have a saved plot named my_plot, produced with ggplot. Also, let's say that the column in my_plot[[1]] data frame used for horizontal axis is named my_dates
Now, I want to add some vertical lines to the plot, which, of course, can be done by something like that:
my_plot +
geom_vline(aes(xintercept = my_dates[c(3, 8)]))
Since I perform this task quite on a regular basis, I want to write a function for that -- something like that:
ggplot.add_lines <- function(given_plot, given_points) {
finale <- given_plot +
geom_vline(aes(xintercept = given_plot[[1]]$my_dates[given_points]))
return(finale)
}
Which, as it's probably obvious to everyone, doesn't work:
> ggplot.add_lines(my_plot, c(3, 5))
Error in eval(expr, envir, enclos) : object 'given_plot' not found
So, my question would be what am I doing wrong, and how can it be fixed? Below is some data for a reproducible example:
> dput(my_plot)
structure(list(data = structure(list(my_dates = c(1, 2, 3, 4,
5, 6, 7, 8, 9, 10), my_points = c(-2.20176409422924, -1.12872396340683,
-0.259703895194354, 0.634233385649338, -0.678983982973015, -1.83157126614836,
1.33360095418957, -0.120455389285709, -0.969431974863616, -1.20451262626184
)), .Names = c("my_dates", "my_points"), row.names = c(NA, -10L
), class = "data.frame"), layers = list(<environment>), scales = <S4 object of class structure("Scales", package = "ggplot2")>,
mapping = structure(list(x = my_dates, y = my_points), .Names = c("x",
"y"), class = "uneval"), theme = list(), coordinates = structure(list(
limits = structure(list(x = NULL, y = NULL), .Names = c("x",
"y"))), .Names = "limits", class = c("cartesian", "coord"
)), facet = structure(list(shrink = TRUE), .Names = "shrink", class = c("null",
"facet")), plot_env = <environment>, labels = structure(list(
x = "my_dates", y = "my_points"), .Names = c("x", "y"
))), .Names = c("data", "layers", "scales", "mapping", "theme",
"coordinates", "facet", "plot_env", "labels"), class = c("gg",
"ggplot"))

According to this post, below is my solution to this problem. The environment issue in the **ply and ggplot is annoying.
ggplot.add_lines <- function(given_plot, given_points) {
finale <- eval(substitute( expr = {given_plot +
geom_vline(aes(xintercept = my_dates[given_points]))}, env = list(given_points = given_points)))
return(finale)
}
The following code runs well on my machine. (I cannot make your reproducible work on my machine...)
df <- data.frame(my_dates = 1:10, val = 1:10)
my_plot <- ggplot(df, aes(x = my_dates, y = val)) + geom_line()
my_plot <- ggplot.add_lines(my_plot, c(3, 5))
print(my_plot)
Update: The above solution fails when more than two points are used.
It seems that we can easily solve this problem by not including the aes (subsetting together with aescauses problems):
ggplot.add_lines <- function(given_plot, given_points) {
finale <- given_plot + geom_vline(xintercept = given_plot[[1]]$my_dates[given_points])
return(finale)
}

I would take the following approach: extract the data.frame of interest, and pass it to the new layer,
df <- data.frame(my_dates = 1:10, val = rnorm(10))
my_plot <- ggplot(df, aes(x = my_dates, y = val)) + geom_line()
add_lines <- function(p, given_points=c(3,5), ...){
d <- p[["data"]][given_points,]
p + geom_vline(data = d, aes_string(xintercept="my_dates"), ...)
}
add_lines(my_plot, c(3,5), lty=2)

Resources