In antononcube/QRMon-R: Quantile Regression Monad

library(magrittr)
library(ggplot2)
library(quantreg)
library(splines)
library(QRMon)

Introduction

Data

data(airquality)
summary(airquality)

library(MASS)
data(mcycle)
summary(mcycle)

Main pipeline

Orlando temperature data

devtools::load_all()

qrmon <-
  QRMonUnit( dfTemperatureData ) %>%
  QRMonRescale(TRUE, TRUE) %>% 
  QRMonQuantileRegression( df = 12, degree = 3, probabilities = 1:9/10 ) %>% 
  QRMonPlot( dataPointsColor = "gray50", regressionCurvesColor = ~ RegressionCurve )

qrmon %>% QRMonSeparateToFractions() %>% QRMonTakeValue()

MASS dataset

(Using this dataset here because it is used in the vignette of the package "quantreg".)

qrmon <-
  QRMonUnit( mcycle ) %>%
  QRMonQuantileRegression( df = 12, degree = 3, probabilities = seq(0.2,0.8,0.2) ) %>% 
  QRMonPlot( dataPointsColor = "gray10", regressionCurvesColor = ~ RegressionCurve )

Fractions

qrmon %>% QRMonSeparateToFractions() %>% QRMonTakeValue()

Conditional CDF's

qrmon <-
  QRMonUnit( dfDistributionData ) %>% 
  QRMonQuantileRegression( df = 6, degree = 3, probabilities = 1:9/10 ) %>% 
  QRMonPlot()

resCDFs <-
  qrmon %>% 
  QRMonConditionalCDF( regressorValues = c(-2,0) ) %>% 
  QRMonTakeValue()

plotDF <- 
  purrr::map_df( names(resCDFs), 
                 function(timePoint) {
                   xs <- qrmon %>% QRMonPredict( newdata = as.numeric(timePoint) ) %>% QRMonTakeValue()
                   xs <- purrr::map_dbl(xs, function(x) x$Value)
                   cbind( Regressor = timePoint, 
                          purrr::map_df( xs, function(x) data.frame( Value = x, CDF = resCDFs[[timePoint]](x) ) ),
                          stringsAsFactors = FALSE)
                 } )

ggplot(plotDF) +
  geom_line( aes(x = Value, y = CDF) ) +
  facet_wrap( ~Regressor, scales = "free")

Outliers

qrmon <-
  QRMonUnit( dfTemperatureData ) %>% 
  QRMonSetRegressionObjects(NULL) %>% 
  QRMonQuantileRegression( df = 16, probabilities = c(0.02,0.98) ) %>% 
  QRMonOutliers() %>% 
  QRMonOutliersPlot( plotRegressionCurvesQ = TRUE )

Errors

data.189185 <-
  data.frame( 
    X = c(1387.5, 1302.5, 1222.5, 1182.5, 1142.5, 1097.5, 852.5, 897.5, 977.5,
          937.5, 812.5, 732.5, 652.5, 692.5, 567.5, 527.5, 447.5, 362.5, 322.5,
          282.5, 242.5, 202.5, 157.5, 1017.9, 77.5),
    Y = c( 266500., 263500., 245500., 238500., 231500., 230500., 224500., 
           224500., 222500., 220500., 217500., 195500., 183500., 183500., 
           176500., 172500., 162500., 145500., 127500., 109500., 93500., 71500., 
           48500., 47970.2, 15500.)
  )

res <-
  QRMonUnit( data.189185 ) %>%
  QRMonQuantileRegression( df = 12, degree = 3, probabilities = 0.5 ) %>% 
  QRMonQuantileRegression( df = 3, degree = 2, probabilities = 0.55 ) %>% 
  QRMonPlot() %>% 
  QRMonErrorsPlot() %>% 
  QRMonTakeValue()

Pick points

qrmon <-
  QRMonUnit( mcycle) %>%
  QRMonQuantileRegression( df = 12, degree = 3, probabilities = 0.5 ) %>% 
  QRMonPlot( dataPointsColor = "gray50", regressionCurvesColor = ~ RegressionCurve ) %>% 
  QRMonErrorsPlot() %>% 
  QRMonPickPathPoints( threshold = 10, pickAboveThresholdQ = FALSE )

ggplot( (qrmon %>% QRMonTakeValue())[[1]] ) +
  geom_point( aes( x = Regressor, y = Value ) )

Simulate

qrmon <-
  QRMonUnit( dfTemperatureData  ) %>% 
  QRMonEchoDataSummary() %>% 
  QRMonSetRegressionObjects( NULL ) %>% 
  QRMonQuantileRegression( df = 16, probabilities = c(0, 0.02, 1:5/6, 0.98, 1) ) %>%
  QRMonPlot( datePlotQ = TRUE, dateOrigin = "1900-01-01", dataPointsColor = "gray80") %>% 
  QRMonTakeValue

#qrmon <- qrmon %>% QRMonSimulate( points = qrmon %>% QRMonTakeData %>% dplyr::pull(Regressor) )
qrmon <- qrmon %>% QRMonSimulate( 1000 )
qDF <- rbind( cbind( Type = "Original", qrmon %>% QRMonTakeData() ),
              cbind( Type = "Simulated", as.data.frame( qrmon %>% QRMonTakeValue() )))
ggplot( qDF ) +
  geom_line( aes( x = Regressor, y = Value ), color = "lightblue" ) +
  facet_wrap( ~Type, ncol=1)

1D simulation emulation with QR example

We cannot do a good emulation of the 1D simulation because quantreg does not allow using interpolation order 0.

probs <- c(0,0.01,1:9/10,0.99,1)

qrmon2 <-
  QRMonUnit( setNames(dfTemperatureData, c("Regressor", "Value" )) ) %>% 
  QRMonQuantileRegression( df = 1, degree = 1, probabilities = probs ) %>% 
  QRMonPlot

qrmon2 <- qrmon2 %>% QRMonSimulate( 1000 )
qDF <- rbind( cbind( Type = "Original", qrmon2 %>% QRMonTakeData() ),
              cbind( Type = "Simulated", as.data.frame( qrmon2 %>% QRMonTakeValue() )))
ggplot( qDF ) +
  geom_line( aes( x = Regressor, y = Value ), color = "lightblue" ) +
  facet_wrap( ~Type, ncol=1)

Quantiles check

quantile( qrmon %>% QRMonTakeData %>% dplyr::pull(Value), probs = probs )

quantile( qrmon2 %>% QRMonTakeValue %>% dplyr::pull(Value), probs = probs )

1D simulation

probs <- c(0,0.01,1:9/10,0.99,1)

qrmon2 <-
  QRMonUnit( setNames(dfTemperatureData, c("Regressor", "Value" )) ) %>% 
  QRMonQuantileRegression( df = 1, degree = 1, probabilities = probs ) %>% 
  QRMonPlot(datePlotQ = T, dateOrigin = "1900-01-01", echoQ = F) %>% 
  QRMonEchoFunctionValue( function(x) x + theme_black() )

qrmon2 <- qrmon2 %>% QRMonSimulate( 1000, method = "CDF" )
qDF <- rbind( cbind( Type = "Original", qrmon2 %>% QRMonTakeData() ),
              cbind( Type = "Simulated", as.data.frame( qrmon2 %>% QRMonTakeValue() )))
ggplot( qDF ) +
  geom_line( aes( x = Regressor, y = Value ), color = "lightblue" ) +
  facet_wrap( ~Type, ncol=1) +
  theme_black()

QRMonUnit( dfFinancialData ) %>% 
  QRMonEchoDataSummary() %>% 
  QRMonQuantileRegression( df = 8, degree = 2, probabilities = 0.5) %>% 
  QRMonSimulate(100, method = 'ConditionalCDF')

Quantiles check

quantile( qrmon %>% QRMonTakeData %>% dplyr::pull(Value), probs = probs )

quantile( qrmon2 %>% QRMonTakeValue %>% dplyr::pull(Value), probs = probs )

Using formulas

qrMon <- 
  QRMonUnit( dfDistributionData ) %>% 
  QRMonQuantileRegressionFit( formula = Value ~ cos(Regressor) + cos(2*Regressor) + Regressor^3, probabilities = 0.5 ) %>% 
  QRMonPlot

qrMon %>% QRMonPredict( c(0, 0.5, 2) ) %>% QRMonTakeValue

antononcube/QRMon-R documentation built on July 26, 2021, 1:07 p.m.