Fiabilidad - Avocados
Esteban Gonzalez
6/20/2020
Introduccion
En este estudio se presenta el estudio del dataframe Avocado prices. En especial se hace enfasis en los precios de los aguacates organicos en el estado de California. En este analisis de series temporales del volumen y precios de venta se puede observar:
La demanda de aguacate organico incrementa.
La demanda de aguacates es temporal, es posible que esto se deba a la produccion de los mismos.
El precio, en promedio, va en aumento.
Distribucion de precios de aguacates
Se puede observar que la distribución de aguacates, tanto orgánico como convencional, es una distribución normal. Si se quisiera clasificar estos aguacates por precio, seria posible separar ambas categorÃas según su precio. El precio promedio del aguacate convencional es de $1.1580, y el precio del aguacate orgánico es de $1.6539. El precio promedio que separarÃa ambas categorÃas seria de $1.4059.
Esto puede deberse a que el producto orgánico es mas escaso y que la producción de aguacate orgánico es mas costosa.
organicMean <- avocadoDF %>% filter(type == "organic")
organicMean <- mean(organicMean$AveragePrice)
conventionalMean <- avocadoDF %>% filter(type == "conventional")
conventionalMean <- mean(conventionalMean$AveragePrice)
#Check prices and how they have changed
ggplot(avocadoDF,
aes(x = AveragePrice,
fill = type)) +
geom_density(alpha = 0.4) +
labs(title = "Price distribution by Avocado type") +
xlab("Average price") +
ylab("Density") +
theme_minimal() +
geom_vline(aes(xintercept = conventionalMean),
color = "red",
alpha = 0.5) +
geom_vline(aes(xintercept = organicMean),
color = "palegreen4",
alpha = 0.5) +
geom_vline(aes(xintercept = (organicMean + conventionalMean)/2),
color = "navyblue",
alpha = 0.5,
label = "Media")## Warning: Ignoring unknown parameters: label
Debido a que los productos orgánicos han cobrado mas fama, debido a que son productos mas naturales, libres de quÃmicos y pesticidas, su demanda también ha ido en aumento. Según se muestra en la siguiente grafica, anualmente ha existido un crecimiento significativo y su demanda ha incrementado.
Debido al incremento de la demanda del mismo, se desea poder predecir el volumen de aguacates que se estará demandando en el futuro, para poder recomendar la cantidad de aguacates que se debe solicitar a los proveedores.
#Check prices and how they have changed
avocadoDistribution <- avocadoDF %>%
group_by(year, type) %>%
summarise(quantity = n(), totalVolume = sum(`Total Volume`)) %>%
mutate(Percentage = totalVolume/sum(totalVolume),
percentLabel = scales::percent(Percentage,
accuracy = 0.01,
decimal.mark = "."))
#Sell distribution in previous years. Organic avocado sales is growing.
ggplot(data = avocadoDistribution,
aes(x = year,
y = totalVolume,
fill = type),
fill = type) +
geom_bar(position = "dodge",
stat="identity") +
geom_text(aes(label = percentLabel),
size = 3,
position = position_dodge2(width = 4,
preserve = "total")) +
labs(title = "Distribution of avocados sold" ) +
xlab("Years 2015 to 2018") +
ylab("Distribution per year") +
theme_minimal()
Se puede observar que en el año 2015 y 2016 existe un comportamiento muy similar:
En invierno, que va desde Diciembre 21 del año anterior hasta Marzo 20 del presente año, la demanda es relativamente alta, en comparación con verano e invierno.
En primavera, que va desde Marzo 20 hasta Junio 20, ocurre la mayor demanda de aguacates en ambos años.
En verano, que inicia en Junio 20 y termina en Septiembre 22, la demanda de aguacates comienza a bajar.
En otoño, que inicia en Septiembre 22 y termina en Diciembre 21, la compra de aguacates se reduce significativamente. Esto podrÃa deberse a lo escaso de los mismos en estas épocas.
#Prices 2015
avocadoDistribution <- avocadoDF %>%
group_by(Date, type, year) %>%
summarise(quantity = n(), totalVolume = sum(`Total Volume`)) %>%
filter(type == "organic") %>%
filter(year == "2015")
#Total avocados sold plot
plot2015 <- ggplot(avocadoDistribution,
aes(x = Date,
y = totalVolume)) +
geom_line(color = "navyblue",
size = 1) +
labs(title = "Avocados sold" ) +
xlab("Date") +
ylab("Avocados sold") +
geom_rect(aes(xmin = as.Date("2015-01-01"),
xmax = as.Date("2015-03-20"),
ymin = -Inf,
ymax = Inf),
alpha = 0.0025,
fill = "blue",
label = "Winter") +
geom_rect(aes(xmin = as.Date("2015-03-20"),
xmax = as.Date("2015-06-20"),
ymin = -Inf,
ymax = Inf),
alpha = 0.005,
fill = "green",
label = "Spring") +
geom_rect(aes(xmin = as.Date("2015-06-20"),
xmax = as.Date("2015-09-22"),
ymin = -Inf,
ymax = Inf),
alpha = 0.01,
fill ="orange",
label = "Summer") +
geom_rect(aes(xmin = as.Date("2015-09-22"),
xmax = as.Date("2015-12-21"),
ymin = -Inf,
ymax = Inf),
alpha = 0.0025,
fill = "peru",
label = "Autumn") +
geom_rect(aes(xmin = as.Date("2015-12-21"),
xmax = as.Date("2015-12-31"),
ymin = -Inf,
ymax = Inf),
alpha = 0.0025,
fill = "blue",
label = "Winter") +
theme_minimal()
#Prices 2016
avocadoDistribution <- avocadoDF %>%
group_by(Date, type, year) %>%
summarise(quantity = n(), totalVolume = sum(`Total Volume`)) %>%
filter(type == "organic") %>%
filter(year == "2016")
#Total avocados sold plot
plot2016 <- ggplot(avocadoDistribution,
aes(x = Date,
y = totalVolume)) +
geom_line(color = "navyblue",
size = 1) +
labs(title = "Avocados sold") +
xlab("Date") +
ylab("Avocados sold") +
geom_rect(aes(xmin = as.Date("2016-01-01"),
xmax = as.Date("2016-03-20"),
ymin = -Inf,
ymax = Inf),
alpha = 0.0025,
fill = "blue",
label = "Winter") +
geom_rect(aes(xmin = as.Date("2016-03-20"),
xmax = as.Date("2016-06-20"),
ymin = -Inf,
ymax = Inf),
alpha = 0.005,
fill = "green",
label = "Spring") +
geom_rect(aes(xmin = as.Date("2016-06-20"),
xmax = as.Date("2016-09-22"),
ymin = -Inf,
ymax = Inf),
alpha = 0.01,
fill = "orange",
label = "Summer") +
geom_rect(aes(xmin = as.Date("2016-09-22"),
xmax = as.Date("2016-12-20"),
ymin = -Inf,
ymax = Inf),
alpha = 0.0025,
fill = "peru",
label = "Autumn") +
geom_rect(aes(xmin = as.Date("2016-12-20"),
xmax = as.Date("2016-12-31"),
ymin = -Inf,
ymax = Inf),
alpha = 0.0025,
fill = "blue",
label = "Winter") +
theme_minimal()
grid.arrange(plot2015,plot2016)
Es posible observar que los patrones que se mencionan anteriormente se repiten año con año, pero se muestra también que la demanda de aguacates orgánicos se incrementa cada año. Tambien se puede notar que existen los picos que se describen anteriormente cada primavera, llegando a ser muy pronunciados, como en el anio 2016.
#Organic avocado Total Volume of avocados sold
avocadoDistribution <- avocadoDF %>%
group_by(Date, type) %>%
summarise(quantity = n(), totalVolume = sum(`Total Volume`)) %>%
filter(type == "organic")
#Total avocados sold plot
ggplot(avocadoDistribution,
aes(x = Date,
y = totalVolume)) +
geom_line(color = "navyblue",
size = 1) +
labs(title = "Avocados sold" ) +
xlab("Date") +
ylab("Total number of Avocados sold") +
theme_minimal()
Se podrÃa tratar de predecir la demanda de aguacates utilizando una regresión lineal simple que dependiera de la fecha y el tiempo. Esto podrÃa darnos una idea aproximada de la demanda de aguacates que podrÃa haber cada año.
#Organic avocado Total Volume of avocados sold
avocadoDistribution <- avocadoDF %>%
group_by(Date, type) %>%
summarise(quantity = n(), totalVolume = sum(`Total Volume`)) %>%
filter(type == "organic")
#Total avocados sold plot
ggplot(avocadoDistribution,
aes(x = Date,
y = totalVolume)) +
geom_line(color = "navyblue",
size = 1) +
geom_smooth(level = 0.95,
method="lm") +
labs(title = "Avocados sold" ) +
xlab("Date") +
ylab("Total number of Avocados sold") +
theme_minimal()
Como se puede observar: la regreson lineal no se ajusta a la data que se presenta. Haciendo un analisis mas cuidadoso de la grafica se puede observar que esta se parece a una grafica sinusoidal inclinada de la forma:
\(y(x) = A*y*sin(\tfrac{2 \pi x}{365})\)
\(y(x) = A*y*cos(\tfrac{2 \pi x}{365})\)
Al utilizar esta ecuación en la regresión lÃnea, es posible observar que la grafica se ajusta de una mejor manera a la demanda de aguacates orgánicos año con año, estimando su crecimiento.
#New DF with the relevant variables that will help with the model
avocadoDistribution <- avocadoDF %>%
group_by(Date, type) %>%
summarise(quantity = n(), totalVolume = sum(`Total Volume`)) %>%
filter(type == "organic")
#In order to use date as a variable, it needs to be converted into a numeric format
numericDate <- as.numeric(avocadoDistribution$Date)
#From the previous graph we can see that the totalAmount of avocados behaviour is similar to a 'tilted' sine wave incrementing in time (amplitude) with a frequency of a year (365)
xc <- numericDate * cos(2*pi*numericDate/365)
xs <- numericDate * sin(2*pi*numericDate/365)
#The linear regression using the numeric date to Tilt the sine wave in addition to a Cosine and a Sine wave
fit.lm <- lm(totalVolume ~ numericDate + xc + xs, data = avocadoDistribution)
fit <- fitted(fit.lm)
#We proceed find predictions for original numericDate series
pred <- predict(fit.lm,
newdata = data.frame(numericDate = numericDate))
#Plot of total organic avocados sold
ggplot(avocadoDistribution,
aes(x = numericDate,
y = totalVolume)) +
geom_line(color = "navyblue",
size = 1) +
geom_line(aes(x = numericDate,
y = pred),
color = "indianred2",
size = 1.5,
alpha = 0.8) +
labs(title = "Avocados sold" ) +
xlab("Date {numeric format}") +
ylab("Total number of Avocados sold") +
theme_minimal()
#The summary shows a promising R^2 and Adjusted R-squared. With Pr(>|t|) (p-values) lower than alpha 0.05
summary(fit.lm)##
## Call:
## lm(formula = totalVolume ~ numericDate + xc + xs, data = avocadoDistribution)
##
## Residuals:
## Min 1Q Median 3Q Max
## -544203 -230070 -21446 162501 1258273
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.21e+07 1.24e+06 -25.79 < 2e-16 ***
## numericDate 2.03e+03 7.30e+01 27.86 < 2e-16 ***
## xc -1.73e+01 2.08e+00 -8.28 3.9e-14 ***
## xs 2.99e+01 2.04e+00 14.63 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 320000 on 165 degrees of freedom
## Multiple R-squared: 0.85, Adjusted R-squared: 0.848
## F-statistic: 312 on 3 and 165 DF, p-value: <2e-16Es facil de visualizar que la grafica se ajusta de una mejor manera al volumen de venta. Esto puede ayudar a predecir de una manera mas acertada teniendo en consideracion las temporadas altas y bajas de demanda de aguacate.
#Plotting errors from my regression
avocadoDistAugmented <- augment(fit.lm)
ggplot(avocadoDistAugmented,
aes(x = numericDate,
y = totalVolume)) +
geom_point(color = "navyblue",
size = 1.5,
alpha = 1) +
geom_line(aes(x = numericDate,
y = pred),
color = "indianred2",
size = 1.5) +
geom_segment(aes(xend = numericDate,
yend = .fitted),
color = "navyblue",
alpha = 0.5,
size = 0.5
) +
labs(title = "Avocados sold" ) +
xlab("Date {numeric format}") +
ylab("Total number of Avocados sold") +
theme_minimal()
## Prediccion de precios
En la primer grafica que se presenta en este estudio, es posible apreciar que los precios de los aguacates orgánicos son mayores al del aguacate convencional. Con mas detalle se puede observar, en la siguiente grafica, que a lo largo del periodo 2015 al 2018 los precios se distribuyen de una forma normal con un precio promedio de: $1.6589.
#Avocado prices
#Avocado prices could be related with the ammount of avocados for sale
avocadoDistribution <- avocadoDF %>%
group_by(Date, AveragePrice,`Total Volume`, type, region, year) %>%
summarise() %>%
filter(type == "organic")
ggplot(avocadoDistribution,
aes(x = AveragePrice,
fill = type)) +
geom_density(alpha = 0.4) +
geom_vline(aes(xintercept = organicMean)) +
labs(title = "Organic Avocado price distribution") +
xlab("Average price") +
ylab("Density") +
theme_minimal()
Un efecto que no se puede apreciar en la grafica anteriro es la correlación que existe entre el precio y el total de aguacates que se venden en California. En las siguientes graficas se pueden apreciar los precios de los aguacates a los largo del año 2015 y 2016 y como mientras el precio baja también el volumen de venta.
avocadoDistribution <- avocadoDF %>% filter(region == "California") %>% filter(type == "organic") %>% filter(year == "2015")
plot2015 <- ggplot(avocadoDistribution,
aes(y = `Total Volume`,
x = AveragePrice)) +
geom_line(size = 1) +
geom_smooth() +
labs(title = "Price and Volume 2015" ) +
xlab("Price") +
ylab("Total Volume") +
theme_minimal()
avocadoDistribution <- avocadoDF %>% filter(region == "California") %>% filter(type == "organic") %>% filter(year == "2016")
plot2016 <- ggplot(avocadoDistribution,
aes(y = `Total Volume`,
x = AveragePrice)) +
geom_line(size = 1) +
geom_smooth() +
labs(title = "Price and Volume 2016" ) +
xlab("Price") +
ylab("Total Volume") +
theme_minimal()
grid.arrange(plot2015,plot2016)
Al graficar los precios a lo largo del periodo 2015-2018 se puede ver el comportamiento temporal de los precios que corresponde a las diferentes estaciones del año.
avocadoDistribution <- avocadoDF %>% filter(region == "California") %>% filter(type == "organic")
ggplot(avocadoDistribution,
aes(y = AveragePrice,
x = Date)) +
geom_line(size = 1) +
labs(title = "Period 2015 - 2018 prices" ) +
xlab("Date") +
ylab("Price") +
theme_minimal()
Al utilizar una ecuación similar a la utilizada al ajustar la grafica de demanda, creando dos sub-sets de la data y entrenando el modelo con este modelo, es posible ver que el modelo se ajusta muy bien a la data que se separo para hacer la prueba del modelo.
El modelo se ajusta muy bien a la data y debido al comportamiento que presenta en las diferentes temporadas es posible replicar esto a lo largo de los años consecuentes.
#Separation of two dataframes for modeling and testing
set.seed(500)
avocadoDF_lm <- (split(avocadoDF, sample(rep(1:2, dim(avocadoDF)[2]))))
avocadoDF_train <- avocadoDF_lm$`1`
avocadoDF_test <- avocadoDF_lm$`2`
avocadoDF_train <- avocadoDF_train %>% filter(type == "organic") %>% filter(region == "California")
avocadoDF_test <- avocadoDF_test %>% filter(type == "organic") %>% filter(region == "California")
#In order to use date as a variable, it needs to be converted into a numeric format
numericDate <- as.numeric(avocadoDF_train$Date)
avocadoDF_train$numericDate <- numericDate
#From the previous graph we can see that the totalAmount of avocados behaviour is similar to a 'tilted' sine wave incrementing in time (amplitude) with a frequency of a year (365)
xc <- -1*I(avocadoDF_train$AveragePrice^2) * cos(2*pi*numericDate/365)
xs <- -1*I(avocadoDF_train$AveragePrice^2) * sin(2*pi*numericDate/365)
#The linear regression using the numeric date to Tilt the sine wave in addition to a Cosine and a Sine wave
fit.lm <- lm(AveragePrice ~ (numericDate + xc + xs + I(xs^2) + xc*xs), data = avocadoDF_train)
fit <- fitted(fit.lm)
#We proceed find predictions for original numericDate series
pred <- predict(fit.lm,
newdata = avocadoDF_test)
#Plot of the data that was kept and will be used to train the model.
ggplot(avocadoDF_train,
aes(x = numericDate,
y = AveragePrice)) +
geom_line(size = 1) +
geom_line(aes(x = numericDate,
y = pred),
color = "indianred2",
size = 1.5,
alpha = 0.8) +
labs(title = "Organic avocado prices" ) +
xlab("Date {Numeric format}") +
ylab("Avocados average price") +
theme_minimal()
#The summary shows a promising R^2 and Adjusted R-squared. With Pr(>|t|) (p-values) lower than alpha 0.05
summary(fit.lm)##
## Call:
## lm(formula = AveragePrice ~ (numericDate + xc + xs + I(xs^2) +
## xc * xs), data = avocadoDF_train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.27889 -0.09649 -0.00283 0.09324 0.29432
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.80e+00 8.48e-01 -4.48 2.6e-05 ***
## numericDate 3.15e-04 4.99e-05 6.30 1.8e-08 ***
## xc 2.25e-02 8.84e-03 2.54 0.013 *
## xs 6.81e-02 1.12e-02 6.10 4.2e-08 ***
## I(xs^2) 1.80e-02 4.15e-03 4.33 4.5e-05 ***
## xc:xs -8.54e-03 3.92e-03 -2.18 0.032 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.147 on 75 degrees of freedom
## Multiple R-squared: 0.787, Adjusted R-squared: 0.773
## F-statistic: 55.4 on 5 and 75 DF, p-value: <2e-16Es posible apreciar que la desviacion del modelo a la data es minima en la siguiente grafica.
#Plotting errors from my regression
avocadoDistAugmented <- augment(fit.lm)
ggplot(avocadoDistAugmented,
aes(x = numericDate,
y = AveragePrice)) +
geom_point(color = "navyblue",
size = 1.5,
alpha = 1) +
geom_line(aes(x = numericDate,
y = pred),
color = "indianred2",
size = 1.5) +
geom_segment(aes(xend = numericDate,
yend = .fitted),
color = "navyblue",
alpha = 0.5,
size = 0.5
) +
labs(title = "Avocado Prices - Historical Annual Data") +
xlab("Date {numeric format}") +
ylab("Avocados average price") +
theme_minimal()