Metal_Prices_index
Sasidhar Maddipatla
10/26/2021
#This is the continuation of the metals price prediction but we are taking 5 metals as per the bet.Import Data.
pacman:: p_load(rio,dplyr,tidyverse,ggplot2,dygraph,xts,zoo)
tungsten <- import("https://pubs.usgs.gov/sir/2012/5188/tables/tungsten.xlsx", skip = 3)
cobalt <- import("https://pubs.usgs.gov/sir/2012/5188/tables/cobalt.xlsx", skip = 3)
copper <- import("https://pubs.usgs.gov/sir/2012/5188/tables/copper.xlsx", skip = 3)
gold <- import("https://pubs.usgs.gov/sir/2012/5188/tables/gold.xlsx", skip = 3)
chromium <- import("https://pubs.usgs.gov/sir/2012/5188/tables/chromium.xlsx", skip = 3)Preview the data and remove unwanted columns
head(tungsten); tail(tungsten)## Year ...2 Price
## 1 1959 NA 13
## 2 1960 NA 19
## 3 1961 NA 17
## 4 1962 NA 12
## 5 1963 NA 9
## 6 1964 NA 15## Year
## 54 Note: Annual average prices were derived from price changes reported in the following sources:
## 55 1959–66, tungsten ore (wolframite) in New York, “ordinary quality,” excluding duty, in American Metal Market.
## 56 1967–73, tungsten ore, domestic quote reflecting the U.S. Government's General Services Administration price, in American Metal Market's Metal Statistics 1972 and Metal Statistics 1974.
## 57 1974–76, tungsten ore, minimum 65% tungsten trioxide, European market, excluding duty, in U.S. Bureau of Mines Minerals Yearbook, converted from pounds sterling per metric ton unit as reported in Metal Bulletin.
## 58 1977–88, tungsten ore, minimum 65% tungsten trioxide, U.S. spot price, c.i.f., excluding duty, in Metals Week.
## 59 1989–2010, ammonium paratungstate, U.S. free market, in Metal Bulletin.
## ...2 Price
## 54 NA NA
## 55 NA NA
## 56 NA NA
## 57 NA NA
## 58 NA NA
## 59 NA NAhead(cobalt); tail(cobalt)## Year ...2 Price
## 1 1937 NA 1.29
## 2 1938 NA 1.36
## 3 1939 NA 1.40
## 4 1940 NA 1.50
## 5 1941 NA 1.50
## 6 1942 NA 1.50## Year
## 79 1979, free market price, cobalt metal, in Engineering and Mining Journal, v. 181, no. 3, 1980, p. 112.
## 80 1980, European free market price, 99.5-percent cobalt metal, in Metal Bulletin Handbook, 1981, p. 73.
## 81 1981, European free market price, 99.5-percent cobalt metal, in Metal Bulletin Handbook, 1982, p. 51, and U.S. spot price, 99.5-percent cobalt cathode, in Metals Week.
## 82 1982–92, U.S. spot price, 99.5-percent cobalt cathode, in Metals Week.
## 83 1993, U.S. spot price, 99.8-percent cobalt cathode, in Metals Week.
## 84 1994–2010, U.S. spot price, 99.8-percent cobalt cathode, in Platts (Platt's) Metals Week.
## ...2 Price
## 79 NA NA
## 80 NA NA
## 81 NA NA
## 82 NA NA
## 83 NA NA
## 84 NA NAhead(copper); tail(copper)## Year ...2 Price
## 1 1850 NA 22
## 2 1851 NA 17
## 3 1852 NA 22
## 4 1853 NA 22
## 5 1854 NA 22
## 6 1855 NA 27## Year
## 166 1899–1908, Electrolytic (99.9-percent-pure copper) refinery price in New York, in Engineering and Mining Journal.
## 167 1909–22, Electrolytic (99.9-percent-pure copper) domestic f.o.b. refinery, in American Metal Market.
## 168 1923–72, Electrolytic (99.9-percent-pure copper) domestic delivered to Connecticut price, in American Metal Market.
## 169 1973–77, U.S. producer electrolytic (99.9-percent-pure copper) wirebar, in Metals Week.
## 170 1978–92, U.S. producer cathode (99.99-percent-pure copper), in Metals Week.
## 171 1993–2010, U.S. producer cathode (99.99-percent-pure copper), in Platts (Platt's) Metals Week.
## ...2 Price
## 166 NA NA
## 167 NA NA
## 168 NA NA
## 169 NA NA
## 170 NA NA
## 171 NA NAhead(gold); tail(gold)## Year ...2 Price
## 1 1968 NA 40.06
## 2 1969 NA 41.51
## 3 1970 NA 36.41
## 4 1971 NA 41.25
## 5 1972 NA 58.60
## 6 1973 NA 97.81## Year
## 42 2009
## 43 2010
## 44 <NA>
## 45 Notes:
## 46 1968–93, Englehard domestic market price, 99.95-percent-pure gold, in Metals Week.
## 47 1994–2010, Englehard domestic market price, 99.95-percent-pure gold, in Platts (Platt's) Metals Week.
## ...2 Price
## 42 NA 974.68
## 43 NA 1227.51
## 44 NA NA
## 45 NA NA
## 46 NA NA
## 47 NA NAhead(chromium); tail(chromium)## Year ...2 Price
## 1 1940 NA 13
## 2 1941 NA 12
## 3 1942 NA 16
## 4 1943 NA 20
## 5 1944 NA 21
## 6 1945 NA 21## Year
## 69 2008
## 70 2009
## 71 2010
## 72 <NA>
## 73 Note:
## 74 Annual mass weighted-average chromite ore value based on quantity and declared free-on-board value of U.S. imports as reported in U.S. Customs statistics, as reported by the U.S. Department of Commerce. Based on U.S. chromite ore import statistics from 1946 through 2009, average chromic oxide content plus or minus average deviation is 43.6 ± 1.9 percent; and chromium content, 29.8 ± 1.3 percent.
## ...2 Price
## 69 NA 227
## 70 NA 227
## 71 NA 230
## 72 NA NA
## 73 NA NA
## 74 NA NAtungsten[2] = NULL
cobalt[2] = NULL
copper[2] = NULL
gold[2] = NULL
chromium[2] = NULLConverting the data to time-series and remove NA’s
tungsten = na.omit(tungsten)# to remove the NAs
tungsten_nominal <- ts(tungsten[2], start=1968, end=2010, frequency=1)
cobalt = na.omit(cobalt) # to remove the NAs
cobalt_nominal <- ts(cobalt[2], start=1968, end=2010, frequency=1)
copper = na.omit(copper) # to remove the NAs
copper_nominal <- ts(copper[2], start=1968, end=2010, frequency=1)
gold = na.omit(gold) # to remove the NAs
gold_nominal <- ts(gold[2], start=1968, end=2010, frequency=1)
chromium = na.omit(chromium) # to remove the NAs
chromium_nominal <- ts(chromium[2], start=1968, end=2010, frequency=1)Getting the cpi index to convert the nominal price of five metals to real price
cpi = pdfetch::pdfetch_FRED("CPIAUCSL") #download cpi all
head(cpi)## CPIAUCSL
## 1947-01-31 21.48
## 1947-02-28 21.62
## 1947-03-31 22.00
## 1947-04-30 22.00
## 1947-05-31 21.95
## 1947-06-30 22.08tail(cpi)## CPIAUCSL
## 2021-04-30 266.832
## 2021-05-31 268.551
## 2021-06-30 270.981
## 2021-07-31 272.265
## 2021-08-31 273.012
## 2021-09-30 274.138str(cpi)## An 'xts' object on 1947-01-31/2021-09-30 containing:
## Data: num [1:897, 1] 21.5 21.6 22 22 21.9 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr "CPIAUCSL"
## Indexed by objects of class: [Date] TZ: UTC
## xts Attributes:
## NULLcpi.ts = ts(cpi, start = c(1968,1), end = c(2021,7), frequency = 12) # convert to time series
#convert to annual series
cpi.annual = window(cpi.ts, start = c(1968,1), end = c(2010, 12), frequency = 1)Converting nominal price to real price for all the five metals.
tungsten_rp=(tungsten_nominal/cpi.annual)*100
cobalt_rp=cobalt_nominal/cpi.annual*100
copper_rp=copper_nominal/cpi.annual*100
gold_rp=gold_nominal/cpi.annual*100
chromium_rp=chromium_nominal/cpi.annual*100
# convert nominal to real by dividing
# nominal price by CPI and multiplying by 100Combined all the required columns and time variable as a dataframe
year=seq(1968,2010,1)
metals = data.frame(cbind(year,tungsten_rp, cobalt_rp,copper_rp, chromium_rp,gold_rp))
head(metals)## year tungsten_rp cobalt_rp copper_rp chromium_rp gold_rp
## 1 1968 60.52142 6.005587 102.42086 60.52142 186.4991
## 2 1969 80.23649 5.743243 71.79054 50.67568 175.2956
## 3 1970 70.80383 5.830904 91.62849 66.63890 151.6451
## 4 1971 51.04211 6.380264 93.57720 85.07018 175.4573
## 5 1972 35.46099 5.910165 86.68243 82.74232 230.8905
## 6 1973 56.71078 5.671078 102.07940 79.39509 369.7921Convert the wide data to long-format and preview the data
metalsdata = metals %>% pivot_longer(cols = c(tungsten_rp, cobalt_rp,copper_rp, chromium_rp,gold_rp),
names_to = "measure",
values_to = "values")
head(metalsdata)## # A tibble: 6 x 3
## year measure values
## <dbl> <chr> <dbl>
## 1 1968 tungsten_rp 60.5
## 2 1968 cobalt_rp 6.01
## 3 1968 copper_rp 102.
## 4 1968 chromium_rp 60.5
## 5 1968 gold_rp 186.
## 6 1969 tungsten_rp 80.2metalsdata = metalsdata %>%
rename(date = year)Filter the data to match the bet-period(1980-1990)
metalsdata_short = metalsdata %>%
filter(date > 1980 & date <= 1990 )
head(metalsdata_short)## # A tibble: 6 x 3
## date measure values
## <dbl> <chr> <dbl>
## 1 1981 tungsten_rp 187.
## 2 1981 cobalt_rp 6.13
## 3 1981 copper_rp 116.
## 4 1981 chromium_rp 95.3
## 5 1981 gold_rp 1565.
## 6 1982 tungsten_rp 184.Calculate the growth attributes to visualize the patterns
metalsdata2 = metalsdata_short %>% group_by(measure) %>%
dplyr::mutate(growth = values - first(values),
growth_percent = (values - first(values))/first(values)*100) Visualize the metals growth
metalsdata2 %>% ggplot(aes(x = date, y = growth, col = measure)) +
geom_line() 
metalsdata2 %>% ggplot(aes(x = date, y = growth_percent, col = measure)) +
geom_line() +
geom_smooth(se = FALSE)## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
Graph them simultaneously after constructing an index relative to the first day.
metalsdata3 = metalsdata_short %>% group_by(measure) %>%
arrange(date) %>%
mutate(growth = values - first(values), growth_percent = (values - first(values))/first(values)*100,
Index = values*100/first(values)
)
head(metalsdata3) ## # A tibble: 6 x 6
## # Groups: measure [5]
## date measure values growth growth_percent Index
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 1981 tungsten_rp 187. 0 0 100
## 2 1981 cobalt_rp 6.13 0 0 100
## 3 1981 copper_rp 116. 0 0 100
## 4 1981 chromium_rp 95.3 0 0 100
## 5 1981 gold_rp 1565. 0 0 100
## 6 1982 tungsten_rp 184. -2.95 -1.58 98.4metalsdata3 %>% ggplot(aes(x = date, y = Index, col = measure)) +
geom_line() +
labs(title = "my graph", subtitle = "metals index")
## Combine all the metals and visualize the metals index patterns.
metalsdata4 = metalsdata3 %>% select(date, measure, values) %>%
pivot_wider(names_from = measure,
values_from = values)
head(metalsdata4)## # A tibble: 6 x 6
## date tungsten_rp cobalt_rp copper_rp chromium_rp gold_rp
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1981 187. 6.13 116. 95.3 1565.
## 2 1982 184. 7.31 158. 87.1 1260.
## 3 1983 266. 7.99 130. 76.6 1411.
## 4 1984 273. 7.98 112. 82.1 1185.
## 5 1985 336. 8.40 82.1 87.3 1027.
## 6 1986 476. 8.31 73.5 79.9 1177. #Construct and Equally Weighted Index of the metal prices
metalsdata4$BigfatIndex = rowSums(metalsdata4[2:6], dims = 1)/5Visualize the metals index
metalsdata4 %>% ggplot(aes(x = date, y = BigfatIndex, col = "darkred")) +
geom_line() +
labs(title = "The bet", subtitle = "metals price")
head(metalsdata4)## # A tibble: 6 x 7
## date tungsten_rp cobalt_rp copper_rp chromium_rp gold_rp BigfatIndex
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1981 187. 6.13 116. 95.3 1565. 394.
## 2 1982 184. 7.31 158. 87.1 1260. 339.
## 3 1983 266. 7.99 130. 76.6 1411. 379.
## 4 1984 273. 7.98 112. 82.1 1185. 332.
## 5 1985 336. 8.40 82.1 87.3 1027. 308.
## 6 1986 476. 8.31 73.5 79.9 1177. 363.Visualize and interact with metals index.
first(metalsdata4$date)## [1] 1981last(metalsdata4$date)## [1] 1990BigFatIndex = ts(metalsdata4$BigfatIndex, start = 1981, end = 1990, frequency = 1)
str(BigFatIndex)## Time-Series [1:10] from 1981 to 1990: 394 339 379 332 308 ...library(dygraphs)## Warning: package 'dygraphs' was built under R version 4.0.5View(BigFatIndex)
dygraphs::dygraph(BigFatIndex, main = "My Time Series",
ylab = "Metal Prices") %>%
dyOptions(
fillGraph=TRUE,
drawGrid = FALSE,
colors="darkred") %>%
dyRangeSelector() %>%
dyCrosshair(direction = "vertical") %>%
dyHighlight(
highlightCircleSize = 5,
highlightSeriesBackgroundAlpha = 0.5,
hideOnMouseOut = FALSE
) Conclusion :
- Paul Ehrlich has lost the bet to Julian simon,
- Because the prices of the 5 metals chosen have gone down over the period of 10 years(1980-1990)
- This means that technology has improved and helped to have the normal prices rather than increasing drastically.
- Metal prices decreased from 1980-1990