Üzüm

Setup

library(rvest)
library(tidyverse)
library(kableExtra)
library(scales)

A helper function for displaying tables

showtable <- function(data, title="") {
  kable(data, caption = title) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), latex_options = "scale_down") 
}

Uzum Salonu

Data Import

Daily Price (Web Scraped)

Extracting the 9 standard price for the day

url <- "https://itb.org.tr/UzumSalonu"

content <- read_html(url)
tables <- content %>% html_nodes("table")
prices <- tables[[2]] %>% html_table()

standard9 <- prices %>% slice(33)
standard9

##                      Ürün (Product) Fiyat (Price) (TL/KG)
## 1 Çek.siz Kuru Üzüm 9 (Std.) (Std.)                 0,000

Reference for task scheduling:

https://cran.r-project.org/web/packages/taskscheduleR/vignettes/taskscheduleR.html

Prices to Date (csv)

data <- read_csv('UzumBorsasi2.csv')

Data Transformation

standard9 <- data %>% select(Date,12, `USD Alis`)
colnames(standard9) <- c('date', 'price', 'USD')
standard9 <- standard9 %>% mutate(ratio = price/USD)
standard9 <- standard9 %>% 
  mutate(year = lubridate::year(date), 
        month = lubridate::month(date), 
        day = lubridate::day(date))
# standard9 <- standard9 %>% 
#   unite("monthday", c("month","day"))

Transform into long format

standard9_long <- standard9 %>% 
  gather(key = "variable", value = "value", price:USD)

Load into database

Coming soon…or not

Data Exploration

showtable(tail(standard9,10), "Last 10 Entries")

Last 10 Entries

date	price	USD	ratio	year	month	day
2019-11-26	10000	5.7383	1742.676	2019	11	26
2019-11-27	9650	5.7528	1677.444	2019	11	27
2019-12-02	10000	5.7426	1741.372	2019	12	2
2019-12-03	9900	5.7365	1725.791	2019	12	3
2019-12-04	9850	5.7360	1717.225	2019	12	4
2019-12-05	9850	5.7488	1713.401	2019	12	5
2019-12-10	9850	5.7987	1698.657	2019	12	10
2019-12-11	9850	5.7987	1698.657	2019	12	11
2019-12-12	9750	5.7875	1684.665	2019	12	12
2019-12-13	9850	5.7875	1701.944	2019	12	13

ggplot(standard9, aes(x = date, y = price)) + 
  geom_point() +
  scale_x_date(date_labels="%b %y", date_breaks="1 month", limits = c(as.Date("2017-6-1"), NA)) +
  theme(axis.text.x = element_text(angle=45, hjust = 1)) +
  ggtitle("Price Time Series")

## Warning: Removed 51 rows containing missing values (geom_point).

ggplot(standard9, aes(x = date, y = USD)) + 
  geom_point() +
  scale_x_date(date_labels="%b %y", date_breaks="1 month", limits = c(as.Date("2017-6-1"), NA)) +
  theme(axis.text.x = element_text(angle=45, hjust = 1)) +
  ggtitle("USD Time Series")

## Warning: Removed 19 rows containing missing values (geom_point).

ggplot(standard9, aes(x = date, y = ratio)) + 
  geom_point() +
  scale_x_date(date_labels="%b %y", date_breaks="1 month", limits = c(as.Date("2017-6-1"), NA)) +
  theme(axis.text.x = element_text(angle=45, hjust = 1)) +
  ggtitle("Ratio Time Series")

## Warning: Removed 51 rows containing missing values (geom_point).

ggplot(standard9_long, aes(x = date, y = value)) + 
  geom_point() + 
  facet_grid(variable ~ ., scales = "free_y") +
  ggtitle("K-USD Time Series")

## Warning: Removed 64 rows containing missing values (geom_point).

p <- ggplot(data = standard9, aes(x = date, y = ratio)) +
  geom_point() + 
  facet_wrap(~year,ncol=1, scales = "free_x") +
  scale_y_continuous(limits = c(1000,NA)) + 
  scale_x_date(date_labels="%d-%b", date_breaks="2 weeks") +
 theme(axis.text.x = element_text(angle = 45, vjust = 0.5, size = 8))
p

## Warning: Removed 51 rows containing missing values (geom_point).

US Production

Data Import

year = c(2014,2015,2016,2017,2018,2019)
production = c(368408,332211,352441,304723,241402,263000)
us_production <- tibble(YEAR = year, PRODUCTION = production)
#us_production <- us_production %>% filter(year != 2016)

ggplot(us_production, aes(x=YEAR, y=PRODUCTION)) + 
  geom_col() + 
  ggtitle("US Production (tons)") + 
  scale_y_continuous(breaks=seq(0,350000,50000))

NOAA Fresno County

Data Import

fresno <- read_csv('fresno.csv')
fresno <- fresno %>% 
  select(DATE,PRCP,TAVG:TMIN) %>% 
  separate(DATE, sep="-", into = c('YEAR','MONTH')) %>% 
  mutate(YEAR = as.numeric(YEAR))

Data Transformation

tmin <- fresno %>% select(YEAR, MONTH, TMIN) %>% spread(MONTH,TMIN) %>% left_join(us_production, by='YEAR')
tmax <- fresno %>% select(YEAR, MONTH, TMAX) %>% spread(MONTH,TMAX) %>% left_join(us_production, by='YEAR')
tavg <- fresno %>% select(YEAR, MONTH, TAVG) %>% spread(MONTH,TAVG) %>% left_join(us_production, by='YEAR')
prcp <- fresno %>% select(YEAR, MONTH, PRCP) %>% spread(MONTH,PRCP) %>% left_join(us_production, by='YEAR')

fresno_long <- fresno %>% gather(key=METRIC, value=VALUE, PRCP:TMIN)

Data Exploration

showtable(tmin, "Min Temperature")

Min Temperature

YEAR	01	02	03	04	05	06	07	08	09	10	11	12	PRODUCTION
2012	35.5	39.9	42.8	48.1	55.9	61.3	65.7	69.3	62.8	NA	45.3	40.7	NA
2013	34.0	37.3	46.2	51.4	57.5	64.9	70.6	65.7	61.2	51.3	NA	32.1	NA
2014	37.8	43.4	47.8	51.9	NA	62.9	69.8	69.1	65.2	57.2	46.1	43.4	368408
2015	38.6	45.4	49.6	50.4	55.5	65.9	68.5	67.5	64.0	57.3	41.4	36.2	332211
2016	40.2	42.7	47.5	NA	57.0	NA	69.0	67.4	NA	51.1	45.2	36.5	352441
2017	38.1	45.0	45.6	48.1	56.4	NA	72.0	71.4	64.5	51.8	45.9	34.4	304723
2018	42.5	40.8	43.5	50.9	56.2	NA	72.5	67.2	62.3	54.4	45.2	40.5	241402
2019	38.3	39.1	45.1	53.3	NA	64.5	NA	69.0	62.2	49.2	NA	NA	263000

showtable(tavg, "Avg. Temperature")

Avg. Temperature

YEAR	01	02	03	04	05	06	07	08	09	10	11	12	PRODUCTION
2012	49.4	53.4	55.9	62.9	72.3	78.0	82.4	86.9	NA	NA	57.4	49.7	NA
2013	47.1	51.0	61.1	66.8	72.2	81.5	87.2	83.1	NA	66.8	NA	47.9	NA
2014	53.9	54.8	61.3	65.9	NA	79.8	86.0	84.4	81.7	72.4	59.6	53.3	368408
2015	49.1	57.4	65.3	65.1	69.5	83.2	84.2	84.0	80.5	72.9	54.1	46.6	332211
2016	49.7	55.5	59.7	NA	70.4	NA	86.1	84.6	NA	70.2	58.4	47.5	352441
2017	47.0	54.4	59.4	62.5	71.2	NA	87.9	86.7	79.0	68.1	57.8	48.5	304723
2018	52.9	54.4	55.4	65.6	71.1	NA	88.3	84.5	79.2	69.8	58.3	50.0	241402
2019	51.0	50.4	57.5	68.8	NA	81.5	NA	85.0	78.7	66.1	NA	NA	263000

showtable(tmax, "Max Temperature")

Max Temperature

YEAR	01	02	03	04	05	06	07	08	09	10	11	12	PRODUCTION
2012	63.1	66.8	69.0	77.6	88.8	94.6	99.1	104.6	NA	NA	69.4	58.8	NA
2013	60.2	64.7	76.1	82.2	86.8	98.1	103.9	100.5	NA	82.2	NA	63.7	NA
2014	69.9	66.3	74.8	80.0	NA	96.8	102.3	99.8	98.3	87.5	73.0	63.2	368408
2015	59.6	69.4	81.0	79.8	83.6	100.5	100.0	100.5	96.9	88.5	66.7	57.0	332211
2016	59.2	68.3	72.0	NA	83.9	NA	103.1	101.8	NA	89.4	71.6	58.6	352441
2017	56.0	63.7	73.2	76.8	86.0	NA	103.8	102.0	93.5	84.4	69.6	62.5	304723
2018	63.4	67.9	67.2	80.2	86.0	NA	104.1	101.9	96.1	85.2	71.3	59.5	241402
2019	63.7	61.8	69.8	84.2	NA	98.5	NA	101.0	95.2	82.9	NA	NA	263000

showtable(prcp, "Precipitation")

Precipitation

YEAR	01	02	03	04	05	06	07	08	09	10	11	12	PRODUCTION
2012	1.30	0.45	2.01	1.83	0.00	0	0.00	0.05	0.00	NA	0.78	2.39	NA
2013	0.45	1.04	0.63	0.09	0.02	0	0.00	0.00	0.01	0.03	NA	0.18	NA
2014	0.55	2.02	0.54	0.69	NA	0	0.01	0.00	0.01	0.00	0.80	2.63	368408
2015	0.21	1.05	0.02	0.67	0.46	0	0.20	0.00	0.05	1.47	2.44	3.09	332211
2016	5.74	1.33	2.59	NA	0.55	NA	0.00	0.00	NA	1.99	1.20	2.78	352441
2017	5.26	2.94	0.60	4.04	0.10	NA	0.00	0.00	0.15	0.09	1.16	0.00	304723
2018	3.82	0.27	4.23	0.53	0.01	NA	0.00	0.00	0.00	0.10	1.65	0.59	241402
2019	2.85	4.07	1.65	1.04	NA	0	0.00	0.00	0.00	0.00	NA	NA	263000

ggplot(fresno_long %>% filter(METRIC != "PRCP"), aes(x=MONTH,y=VALUE,color=METRIC)) + 
  geom_boxplot() +
  ggtitle("Temperature Monthly Distribution")

## Warning: Removed 7 rows containing non-finite values (stat_boxplot).

ggplot(fresno_long %>% filter(METRIC == "PRCP"), aes(x=MONTH,y=VALUE,color=METRIC)) + 
  geom_boxplot() +
  ggtitle("Precipitation Monthly Distribution")

Data Modeling

#m <- lm(PRODUCTION ~ `01`+`02`+`03`+`04`+`05`+`06`+`07`+`08`+`09`+`10`+`11`+`12`, data = tmax)
# m <- lm(PRODUCTION ~ `03`, data = tavg)
# summary(m)

# plot(PRODUCTION ~ `01`+`02`+`03`+`04`+`05`+`06`+`07`+`08`+`09`+`10`+`11`+`12`, data = prcp)
# abline(m)