## ---- fig.show='hold', fig.width=7, fig.height=4.5---------------------------- x = seq(1,10) y = log(x) xarray = seq(1,10,0.01) BaseSpline = splinefun(x,y, method = "monoH.FC") Base0 = BaseSpline(xarray) DerivBaseSpline = splinefun(xarray, numDeriv::grad(BaseSpline, xarray)) Base1 = DerivBaseSpline(xarray) Deriv2BaseSpline = splinefun(xarray, numDeriv::grad(DerivBaseSpline, xarray)) Base2 = Deriv2BaseSpline(xarray) plot(xarray, Base0, type = "l", col = 4, ylim = c(-1,3), main = "Base Spline and first two derivatives", ylab = "Spline and derivatives", xlab = "x") lines(xarray, Base1, col = 2) lines(xarray, Base2, col = 3) abline(h = 0, col = 1) text(x=rep(8,8,8), y=c(2, 0.5,-0.2), pos=4, labels=c('Spline', 'First Derivative', 'Second Derivative')) ## ---- fig.show='hold', fig.width=7, fig.height=4.5---------------------------- library(schumaker) ## ---- fig.show='hold', fig.width=7, fig.height=4.5---------------------------- SchumSpline = schumaker::Schumaker(x,y) Schum0 = SchumSpline$Spline(xarray) Schum1 = SchumSpline$DerivativeSpline(xarray) Schum2 = SchumSpline$SecondDerivativeSpline(xarray) plot(xarray, Schum0, type = "l", col = 4, ylim = c(-1,3), main = "Schumaker Spline and first two derivatives", ylab = "Spline and derivatives", xlab = "x") lines(xarray, Schum1, col = 2) lines(xarray, Schum2, col = 3) abline(h = 0, col = 1) text(x=rep(8,8,8), y=c(2, 0.5,-0.2), pos=4, labels=c('Spline', 'First Derivative', 'Second Derivative')) ## ---- fig.show='hold', fig.width=7, fig.height=4.5---------------------------- x = seq(1,10) y = log(x) xarray = seq(-5,15,0.01) SchumSplineCurve = Schumaker(x,y, Extrapolation = "Curve" )$Spline SchumSplineConstant = Schumaker(x,y, Extrapolation = "Constant")$Spline SchumSplineLinear = Schumaker(x,y, Extrapolation = "Linear" )$Spline SchumSplineCurveVals = SchumSplineCurve(xarray) SchumSplineConstantVals = SchumSplineConstant(xarray) SchumSplineLinearVals = SchumSplineLinear(xarray) plot(xarray, SchumSplineCurveVals, type = "l", col = 1, ylim = c(-5,5), main = "Ways of predicting outside of sample", ylab = "Spline value", xlab = "x") lines(xarray, SchumSplineConstantVals, col = 2) lines(xarray, SchumSplineLinearVals, col = 3) ## ---- fig.show='hold', fig.width=7, fig.height=4.5---------------------------- x = c(-3,-1,-0.5,0) y = c(0, 0.007, 2, 5) sp_all = Schumaker(x,y) sp = sp_all$Spline sp1 = sp_all$DerivativeSpline sp2 = sp_all$SecondDerivativeSpline xarray = seq(min(x), max(x), length.out = 500) yarray0 = sp(xarray) plot(x,y, col = 1) lines(xarray,yarray0, col = 2) yarray1 = sp1(xarray) lines(xarray,yarray1, col = 3) yarray2 = sp2(xarray) lines(xarray,yarray2, col = 4) ## ---- fig.show='hold', fig.width=7, fig.height=4.5---------------------------- x = c(-3,-1,-0.5,0) y = c(0, 0.007, 2, 5) sp_all = Schumaker(x,y, edgeGradients = c(0,NA)) sp = sp_all$Spline sp1 = sp_all$DerivativeSpline sp2 = sp_all$SecondDerivativeSpline xarray = seq(min(x), max(x), length.out = 500) yarray0 = sp(xarray) plot(x,y, col = 1) lines(xarray,yarray0, col = 2) yarray1 = sp1(xarray) lines(xarray,yarray1, col = 3) yarray2 = sp2(xarray) lines(xarray,yarray2, col = 4) ## ---- fig.show='hold', fig.width=7, fig.height=4.5---------------------------- RICs = c("BARC.L", "VOD.L", "IBM.L") Dates = as.Date(c("11-11-2019", "12-11-2019", "13-11-2019", "14-11-2019", "15-11-2019"), format="%d-%m-%Y") times = seq(0,28800, length.out = 10) # We are going to interpolate by time of day. This is the x variable. So we state it in terms of seconds. from start of day's trade. dd = expand.grid(TIME = times, Date = Dates, RIC = RICs) dd = merge(dd, data.frame(RIC = RICs, PRICE = c(160.00, 162.24, 137.24))) # Making example prices. These are not accurate and I am ignoring currency. randomness = rlnorm(dim(dd)[1]) dd$PRICE = dd$PRICE * cumprod(randomness) ## ---- fig.show='hold', fig.width=7, fig.height=4.5---------------------------- approx_func = function(x,y){approxfun(x, y)} dispatched_approxfun = make_approx_functions_from_dataframe(dd, group_vars = c("RIC", "Date"), x_var = "TIME", y_var = "PRICE", approx_func) dispatched_approxfun("BARC.L", Dates[2], c(100, 156, 6045)) approx_func = function(x,y){Schumaker(x, y)$Spline} approxfun_in_lists = make_approx_functions_from_dataframe(dd, group_vars = c("RIC", "Date"), x_var = "TIME", y_var = "PRICE", approx_func) dispatched_approxfun("IBM.L", Dates[3], c(100, 156, 6045)) ## ---- fig.show='hold', fig.width=7, fig.height=4.5---------------------------- library(cobs) library(scam) x = seq(1,10) y = log(x) dat = data.frame(x = x, y = y) xarray = seq(0,15,0.01) ScamSpline = function(dat) {scam::scam(y~s(x,k=4,bs="mdcx",m=1),data=dat)} CobsSpline = function(x,y) {cobs::cobs(x , y, constraint = c("decrease", "convex"), print.mesg = FALSE)} CreateSplineTest = rbenchmark::benchmark( replicate(10, Schumaker(x,y)), replicate(10,splinefun(x,y,"monoH.FC")), replicate(10,ScamSpline(dat)), replicate(10,CobsSpline(x,y)), columns = c('test','elapsed', 'relative') ) print(CreateSplineTest) BaseSp = splinefun(x,y,"monoH.FC") SchuSp = Schumaker(x,y)$Spline ScamSp = scam::scam(y~s(x,k=4,bs="mdcx",m=1),data=dat) CobsSp = cobs::cobs(x , y, constraint = c("decrease", "convex"), print.mesg = FALSE) ScamPr = function(x){ scam::predict.scam(ScamSp,data.frame(x = x))} CobsPr = function(x){ predict(CobsSp, x)[,2] } PredictArrayTest = rbenchmark::benchmark( replicate(10,SchuSp(xarray)), replicate(10,BaseSp(xarray)), replicate(10,ScamPr(xarray)), replicate(10,CobsPr(xarray)), columns = c('test','elapsed', 'relative') ) print(PredictArrayTest) SchuSp = Schumaker(x,y, Vectorise = FALSE)$Spline PredictPointTest = rbenchmark::benchmark( replicate(100,SchuSp(runif(1))), replicate(100,BaseSp(runif(1))), replicate(100,ScamPr(runif(1))), replicate(100,CobsPr(runif(1))), columns = c('test','elapsed', 'relative') ) print(PredictPointTest)