copper mining companies indicator and copper prices

0.1 Preliminaries
1 Background
2 Research Questions
3 My Data
- 3.1 Data Load
4 Code Book
5 Analyses
6 Conclusions

0.1 Preliminaries

library(skimr)
library(simputation)
library(Epi)
library(broom)
library(rms)
library(MASS)
library(nnet)
library(ROCR)
library(survival)
library(tidyverse)

skim_with(numeric = list(hist = NULL),
          integer = list(hist = NULL))

1 Background

Changes in copper’s price are theorized to drive the stock prices of copper mining companies in the same direction as an effect of the Law of Supply and Demand.

In general, a decrease in coppers price indicates decrease the need for mining copper and that pushes investors away from mining companies, which in turn manifests as a decrease in their stock’s prices, while a surge in copper’s price pushes stock’s prices of copper mining companies up.

The response to changes in copper prices does not happen immediately due to various factors. But it usually happens after a delay.

In this study, I will investigate other exogenous factors that affect the stock price adjustment.

2 Research Questions

What are the factors that affect the relationship between changes in copper prices and copper mining companies stock market prices?

3 My Data

src:finance.yahoo.com

Dow Jone: is a price-weighted average of 30 significant stocks traded on the New York Stock Exchange (NYSE) and the NASDAQ.

Nasdaq: Nasdaq is a global electronic marketplace for buying and selling securities, as well as the benchmark index for U.S. technology stocks.

S&P 500 Index: is an index of 505 stocks issued by 500 large companies with market capitalizations of at least $6.1 billion. It is seen as a leading indicator of U.S. equities and a reflection of the performance of the large-cap universe

src:http://www.macrotrends.net

Federal Funds Rate: The federal funds rate is the rate at which depository institutions (banks) lend reserve balances to other banks on an overnight basis. Reserves are excess balances held at the Federal Reserve to maintain reserve requirements

3 Month LIBOR Rate

1 Year LIBOR Rate

London Interbank Offered Rate. It’s the rate of interest at which banks offer to lend money to one another in the wholesale money markets in London. It is a standard financial index used in U.S. capital markets and can be found in The Wall Street Journal. In general, its changes have been smaller than changes in the prime rate.

3-Month Treasury Bill

30 Year Treasury Rate

The U.S. Treasury sells bonds to the public as a way of borrowing money. They sell bonds with various maturities–most common being the three-month T-bill and the 30 year Treasury bond. The higher price usually occurs when investors are worried about the safety of other instruments.

Crude Oil Prices

natural-gas-prices

Industrial Production Mining Copper nickel lead and zinc mining

copper-prices

src:fred.stlouisfed.org

Industrial Production Index: is a monthly economic indicator measuring real output in the manufacturing, mining, electric and gas industries, The Federal Reserve Board (FRB) publishes the industrial production index (IPI) at the middle of every month

GDP:s the monetary value of all the finished goods and services produced within a country’s borders in a specific time period. Though GDP is usually calculated on an annual basis, it can be calculated on a quarterly basis as well (in the United States, for example, the government releases an annualized GDP estimate for each quarter and also for an entire year), I used percent Change from Quarter One Year Ago, Seasonally Adjusted

src:nasdaq.com COPX: Global X Copper Miners ETF, The underlying index is designed to measure broad-based equity market performance of global companies involved in the copper mining industry.

3.1 Data Load

library(readr)
data <- read_csv("data_cu_0_5_COPX_2.csv", col_types = cols(date = col_skip()))

skim(data)

Skim summary statistics
 n obs: 1145 
 n variables: 15 

Variable type: numeric 
                     variable missing complete    n    mean     sd      p0
                       copper       0     1145 1145   3.13    0.63    1.96
                copper_change       0     1145 1145  -0.024   1.69   -7.01
                         COPX       0     1145 1145  30.7    12.92    9.08
               Dow_Jones_diff       0     1145 1145 -10.22  145.66 -669.4 
  Industrial_Production_Index       0     1145 1145 101.72    3.06   95.1 
 Industrial_Production_Mining       0     1145 1145 107.58    9.87   88.3 
                      latency       0     1145 1145  12.48   11.69    2   
                    LIBOR_12M       0     1145 1145   1.05    0.48    0.53
                     LIBOR_3M       0     1145 1145   0.55    0.44    0.22
                  NASDAQ_diff       0     1145 1145  -3.14   44.92 -227.87
                          oil       0     1145 1145  82.73   29.25   26.01
           significant_change       0     1145 1145   0.7     0.46    0   
                   SP500_diff       0     1145 1145  -1.15   16.68  -72.9 
                        TB3MS       0     1145 1145   0.26    0.4     0.01
             Treasury_30_Year       0     1145 1145   3.17    0.55    2.11
    p25 median    p75    p100
   2.63   3.15   3.54    4.63
  -1.12  -0.51   1.17    7.32
  21.23  27.81  39.48   62.22
 -78.33 -11.11  47.51 1175.21
  99.9  102.07 103.77  106.66
  99.97 107.97 115.57  126.93
   3      6     30      30   
   0.71   0.85   1.23    2.71
   0.27   0.33   0.63    2.34
 -26.26  -4.49  16.08  273.42
  52.35  93.52 109.39  128.14
   0      1      1       1   
  -9.33  -1.21   5.51  113.19
   0.03   0.08   0.27    1.7 
   2.82   3.04   3.4     4.76

data %>% count(significant_change)

# A tibble: 2 x 2
  significant_change     n
               <dbl> <int>
1                  0   345
2                  1   800

4 Code Book

copper: price of copper

copper_change: percentage of the changes in copper price. inclusion criteria is chanes in copper prices is >0.5%

oil: price of crude oil

Industrial_Production_Index

Industrial_Production_Mining

LIBOR_3M:3 Month LIBOR Rate

LIBOR_12M:1 Year LIBOR Rate

TB3MS:3-Month Treasury Bill

Treasury_30_Year:30 Year Treasury Rate

Dow_Jones_diff: changes in Dow Jones in points

NASDAQ_diff: changes in NASDAQ in points

SP500_diff:changes in S&P500 in points

COPX: value of Global X Copper Miners ETF

latency: the time needed to COPX to follow the changes of copper prices in same directions, the threshold is more than 0.5% change, upto 10 days, if the price didn’t follow the changes of it was below the threshold. it got value of 30

significant_change: 1 if prices of COPX changed in the same direction as copper during 10 days perios more than 2%, 0 if not.

5 Analyses

ggplot(data = data, aes(x = copper_change)) +
geom_histogram(color = "white", bins = 20) +
labs(title = "Change in copper price and same direction changes in stock price of COPX.\n",
     subtitle = "0: No significat changes have been seen.\n1: Same direction changes have been seen in 10 days period",
x = "percentage changes in copper price") +
guides(fill = FALSE) +
facet_grid(significant_change ~ .)

fit a Logistic Regression with the fact of changes in COPX as an outcome

m1 <- lrm(significant_change ~ copper_change +oil + Industrial_Production_Index +Industrial_Production_Mining+
            LIBOR_3M + LIBOR_12M+TB3MS+Treasury_30_Year+Dow_Jones_diff+NASDAQ_diff+SP500_diff,
data = data)
m1

Logistic Regression Model
 
 lrm(formula = significant_change ~ copper_change + oil + Industrial_Production_Index + 
     Industrial_Production_Mining + LIBOR_3M + LIBOR_12M + TB3MS + 
     Treasury_30_Year + Dow_Jones_diff + NASDAQ_diff + SP500_diff, 
     data = data)
 
                       Model Likelihood     Discrimination    Rank Discrim.    
                          Ratio Test           Indexes           Indexes       
 Obs          1145    LR chi2     111.61    R2       0.132    C       0.692    
  0            345    d.f.            11    g        0.830    Dxy     0.383    
  1            800    Pr(> chi2) <0.0001    gr       2.294    gamma   0.383    
 max |deriv| 9e-06                          gp       0.161    tau-a   0.161    
                                            Brier    0.190                     
 
                              Coef    S.E.   Wald Z Pr(>|Z|)
 Intercept                    16.0774 5.5968  2.87  0.0041  
 copper_change                 0.0284 0.0443  0.64  0.5218  
 oil                          -0.0191 0.0040 -4.75  <0.0001 
 Industrial_Production_Index  -0.1077 0.0518 -2.08  0.0374  
 Industrial_Production_Mining -0.0392 0.0124 -3.16  0.0016  
 LIBOR_3M                      7.5883 2.0575  3.69  0.0002  
 LIBOR_12M                    -1.9631 1.2950 -1.52  0.1295  
 TB3MS                        -6.3706 1.1433 -5.57  <0.0001 
 Treasury_30_Year              0.3475 0.2235  1.55  0.1200  
 Dow_Jones_diff               -0.0019 0.0022 -0.87  0.3845  
 NASDAQ_diff                  -0.0036 0.0049 -0.72  0.4700  
 SP500_diff                    0.0153 0.0266  0.57  0.5660

plot(anova(m1))

sp_smart <- spearman2(significant_change ~ copper_change +oil + Industrial_Production_Index +Industrial_Production_Mining+
            LIBOR_3M + LIBOR_12M+TB3MS+Treasury_30_Year+Dow_Jones_diff+NASDAQ_diff+SP500_diff,
data = data)
plot(sp_smart)

ggplot(data , aes(x = factor(significant_change), y = LIBOR_3M)) +
geom_violin(aes(fill = significant_change), trim = TRUE) +
geom_boxplot(width = 0.2) +
guides(fill = FALSE, color = FALSE) +
  labs(title = "3 Month LIBOR Rate and same direction\n changes of prices for both copper and COPX",
y = "3 Month LIBOR Rate",
x = "COPX changes followed copper price changes in the same direction\n
1 if its seen in during 10 days"
) +
theme_bw()

ggplot(data , aes(x = factor(significant_change), y = LIBOR_12M)) +
geom_violin(aes(fill = significant_change), trim = TRUE) +
geom_boxplot(width = 0.2) +
guides(fill = FALSE, color = FALSE) +
  labs(title = "12 Month LIBOR Rate and same direction\n changes of prices for both copper and COPX",
y = "12 Month LIBOR Rate",
x = "COPX changes followed copper price changes in the same direction\n
1 if its seen in during 10 days"
) +
theme_bw()

ggplot(data , aes(x = factor(significant_change), y = Industrial_Production_Index)) +
geom_violin(aes(fill = significant_change), trim = TRUE) +
geom_boxplot(width = 0.2) +
guides(fill = FALSE, color = FALSE) +
  labs(title = "Industrial Production Index and same direction\n changes of prices for both copper and COPX",
y = "Industrial Production Index",
x = "COPX changes followed copper price changes in the same direction\n
1 if its seen in during 10 days"
) +
theme_bw()

ggplot(data , aes(x = factor(significant_change), y = Industrial_Production_Mining)) +
geom_violin(aes(fill = significant_change), trim = TRUE) +
geom_boxplot(width = 0.2) +
guides(fill = FALSE, color = FALSE) +
  labs(title = "Industrial Production Mining Index and same direction\n changes of prices for both copper and COPX",
y = "Industrial Production Mining Index",
x = "COPX changes followed copper price changes in the same direction\n
1 if its seen in during 10 days"
) +
theme_bw()

GGally::ggpairs(data %>%
select(LIBOR_3M, LIBOR_12M, Industrial_Production_Index,Industrial_Production_Mining))

fitting a models with single varialble model

mod_LIBOR_3M <- glm(significant_change ~  LIBOR_3M,
data = data, family = binomial)


prob <- predict(mod_LIBOR_3M, data, type="response")
pred <- prediction(prob, data$significant_change)
perf <- performance(pred, measure = "tpr", x.measure = "fpr")
auc <- performance(pred, measure="auc")
auc <- round(auc@y.values[[1]],3)
roc.data <- data.frame(fpr=unlist(perf@x.values),
tpr=unlist(perf@y.values),
model="GLM")
ggplot(roc.data, aes(x=fpr, ymin=0, ymax=tpr)) +
  geom_ribbon(alpha=0.2, fill = "blue") +
geom_line(aes(y=tpr), col = "blue") +
geom_abline(intercept = 0, slope = 1, lty = "dashed") +
labs(title = paste0("LIBOR 3 month only: ROC Curve w/ AUC=", auc)) +
theme_bw()

mod_LIBOR_12M <- glm(significant_change ~  LIBOR_12M,
data = data, family = binomial)


prob <- predict(mod_LIBOR_12M, data, type="response")
pred <- prediction(prob, data$significant_change)
perf <- performance(pred, measure = "tpr", x.measure = "fpr")
auc <- performance(pred, measure="auc")
auc <- round(auc@y.values[[1]],3)
roc.data <- data.frame(fpr=unlist(perf@x.values),
tpr=unlist(perf@y.values),
model="GLM")
ggplot(roc.data, aes(x=fpr, ymin=0, ymax=tpr)) +
  geom_ribbon(alpha=0.2, fill = "blue") +
geom_line(aes(y=tpr), col = "blue") +
geom_abline(intercept = 0, slope = 1, lty = "dashed") +
labs(title = paste0("LIBOR 12 month only: ROC Curve w/ AUC=", auc)) +
theme_bw()

mod_Industrial_Production_Index <- glm(significant_change ~  Industrial_Production_Index,
data = data, family = binomial)


prob <- predict(mod_Industrial_Production_Index, data, type="response")
pred <- prediction(prob, data$significant_change)
perf <- performance(pred, measure = "tpr", x.measure = "fpr")
auc <- performance(pred, measure="auc")
auc <- round(auc@y.values[[1]],3)
roc.data <- data.frame(fpr=unlist(perf@x.values),
tpr=unlist(perf@y.values),
model="GLM")
ggplot(roc.data, aes(x=fpr, ymin=0, ymax=tpr)) +
  geom_ribbon(alpha=0.2, fill = "blue") +
geom_line(aes(y=tpr), col = "blue") +
geom_abline(intercept = 0, slope = 1, lty = "dashed") +
labs(title = paste0("Industrial Production Index only: ROC Curve w/ AUC=", auc)) +
theme_bw()

mod_Industrial_Production_Mining <- glm(significant_change ~  Industrial_Production_Mining,
data = data, family = binomial)


prob <- predict(mod_Industrial_Production_Mining, data, type="response")
pred <- prediction(prob, data$significant_change)
perf <- performance(pred, measure = "tpr", x.measure = "fpr")
auc <- performance(pred, measure="auc")
auc <- round(auc@y.values[[1]],3)
roc.data <- data.frame(fpr=unlist(perf@x.values),
tpr=unlist(perf@y.values),
model="GLM")
ggplot(roc.data, aes(x=fpr, ymin=0, ymax=tpr)) +
  geom_ribbon(alpha=0.2, fill = "blue") +
geom_line(aes(y=tpr), col = "blue") +
geom_abline(intercept = 0, slope = 1, lty = "dashed") +
labs(title = paste0("Industrial Production Mining Index only: ROC Curve w/ AUC=", auc)) +
theme_bw()

mod_oil <- glm(significant_change ~  oil,
data = data, family = binomial)


prob <- predict(mod_oil, data, type="response")
pred <- prediction(prob, data$significant_change)
perf <- performance(pred, measure = "tpr", x.measure = "fpr")
auc <- performance(pred, measure="auc")
auc <- round(auc@y.values[[1]],3)
roc.data <- data.frame(fpr=unlist(perf@x.values),
tpr=unlist(perf@y.values),
model="GLM")
ggplot(roc.data, aes(x=fpr, ymin=0, ymax=tpr)) +
  geom_ribbon(alpha=0.2, fill = "blue") +
geom_line(aes(y=tpr), col = "blue") +
geom_abline(intercept = 0, slope = 1, lty = "dashed") +
labs(title = paste0("Oil only: ROC Curve w/ AUC=", auc)) +
theme_bw()

mod_TB3MS <- glm(significant_change ~  TB3MS,
data = data, family = binomial)


prob <- predict(mod_TB3MS, data, type="response")
pred <- prediction(prob, data$significant_change)
perf <- performance(pred, measure = "tpr", x.measure = "fpr")
auc <- performance(pred, measure="auc")
auc <- round(auc@y.values[[1]],3)
roc.data <- data.frame(fpr=unlist(perf@x.values),
tpr=unlist(perf@y.values),
model="GLM")
ggplot(roc.data, aes(x=fpr, ymin=0, ymax=tpr)) +
  geom_ribbon(alpha=0.2, fill = "blue") +
geom_line(aes(y=tpr), col = "blue") +
geom_abline(intercept = 0, slope = 1, lty = "dashed") +
labs(title = paste0("3-Month Treasury Bill only: ROC Curve w/ AUC=", auc)) +
theme_bw()

mod_final <- glm(significant_change ~  LIBOR_3M*TB3MS +  Industrial_Production_Mining +oil,
data = data, family = binomial)


prob <- predict(mod_final, data, type="response")
pred <- prediction(prob, data$significant_change)
perf <- performance(pred, measure = "tpr", x.measure = "fpr")
auc <- performance(pred, measure="auc")
auc <- round(auc@y.values[[1]],3)
roc.data <- data.frame(fpr=unlist(perf@x.values),
tpr=unlist(perf@y.values),
model="GLM")
ggplot(roc.data, aes(x=fpr, ymin=0, ymax=tpr)) +
  geom_ribbon(alpha=0.2, fill = "blue") +
geom_line(aes(y=tpr), col = "blue") +
geom_abline(intercept = 0, slope = 1, lty = "dashed") +
labs(title = paste0("Final model: ROC Curve w/ AUC=", auc)) +
theme_bw()

plot(mod_final,5)

train_control<- caret::trainControl(method="cv", number=20)

model<- caret::train(significant_change ~  LIBOR_3M*TB3MS +  Industrial_Production_Mining +oil,data=data, method="glm", family=binomial())


summary(model)


Call:
NULL

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.2506  -1.1865   0.6553   0.8585   1.4548  

Coefficients:
                              Estimate Std. Error z value Pr(>|z|)    
(Intercept)                   8.755520   1.375764   6.364 1.96e-10 ***
LIBOR_3M                      3.876268   0.743167   5.216 1.83e-07 ***
TB3MS                        -6.370909   1.064320  -5.986 2.15e-09 ***
Industrial_Production_Mining -0.064958   0.009667  -6.720 1.82e-11 ***
oil                          -0.019391   0.003971  -4.883 1.04e-06 ***
`LIBOR_3M:TB3MS`              0.812879   0.430953   1.886   0.0593 .  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1401.4  on 1144  degrees of freedom
Residual deviance: 1308.0  on 1139  degrees of freedom
AIC: 1320

Number of Fisher Scoring iterations: 4

6 Conclusions

Equity market investors react to changes in copper commodity prices by bidding on the stock prices of the copper mining companies, with an eye on medium-term health indicators of the economy. In general, the 3-month LIBOR rate and 3-Month Treasury Bill move in tandum and suggest stronger economic growth in the short term and at the same time longer-term economic risks.