Library

library(tidyverse) 

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.4.4     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(tidyquant) 

## Loading required package: PerformanceAnalytics
## Loading required package: xts
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
## # dplyr from breaking base R's lag() function.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################
## 
## Attaching package: 'xts'
## 
## The following objects are masked from 'package:dplyr':
## 
##     first, last
## 
## 
## Attaching package: 'PerformanceAnalytics'
## 
## The following object is masked from 'package:graphics':
## 
##     legend
## 
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

library(plotly)

## 
## Attaching package: 'plotly'
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following object is masked from 'package:graphics':
## 
##     layout

library(timetk)
library(forcats) 

Pendahuluan

Seperti yang kita ketahui, perkembangan teknologi sangat perpengaruh besar bagi perkembangan ekonomi global. Perkembangan teknologi ini memudahkan kita dalam berinvestasi di perusahaan yang kita inginkan. Banyak investor saham khususnya yang merasa dimudahkan dengan perkembangan teknologi yang sangat pesat. Selain itu mulai muncul mata uang digital atau yang kita kenal sebagai cypto yang dimana mata uang ini sudah mulai menyebar dikalangan menengah keatas. Pada kesempatan ini saya ingin melakukan optimalisasi portofolio terhadap perkembangan Crypto secara global. Berikut ini adalah grafik yang menunjukan perkembangan salah satu mata uang crypto yaitu Etherium.

price_data <- tq_get('ETH-USD',
                      from = '2018-01-03',
                     to = '2023-07-01',
                     get = 'stock.prices')

price_data %>%
  plot_ly(x = ~date,
          type = 'candlestick',
          open = ~open,
          close = ~close,
          high = ~high,
          low = ~low) %>%
  layout(title = 'Harga Stok Market Etherium Sejak 2018-2023',
         xaxis = list(rangeslider = list(visible = F)))

Proses Optimalisasi Portofolio

para investor profesional juga mempertimbangkan proses optimalisasi portofolio dalam mengendalikan resiko investasi mereka. Teori optimalisasi portofolio yang dalam istilah bahasa ingris disebut Modern portfolio theory (MPT) menyatakan bahwa investor cendrung menghidari risiko, mereka akan memilih portofolio yang menawarkan pengembalian paling banyak. Untuk melakukan itu kita perlu mengoptimalkan portofolio, langkah yang harus dilakukan adalah

1. Mengumpulkan data harga aset yang diplih.
2. Memilih aset yang tidak beresiko dengan memperhatikan trend harga aset.
3. Melakukan analisis korelasi antar aset yang akan dipilih.
4. Menghitung pengembalian data periode waktu.
5. Menetapkan bobot guna untuk membangun pembatas yang efisien.

# daftar data saham yg ingin diimport
tick <- c('ETH-USD','MATIC-USD','LINK-USD','ALGO-USD','XMR-USD')

price_data <- tq_get(tick,
                     from = '2018-01-03',
                     to = '2023-07-01',
                     get = 'stock.prices')

knitr::kable(head(price_data))

log_ret_tidy <- price_data %>%
  group_by(symbol) %>%
  tq_transmute(select = adjusted,
               mutate_fun = periodReturn,
               period = 'daily',
               col_rename = 'ret',
               type = 'log')

knitr::kable(head(log_ret_tidy))

log_ret_xts <- log_ret_tidy %>%
  spread(symbol, value = ret) %>%
  tk_xts()

## Warning: Non-numeric columns being dropped: date

## Using column `date` for date_var.

knitr::kable(head(log_ret_xts))

log_ret_xts[is.na(log_ret_xts)] <- 0
knitr::kable(head(log_ret_xts))

mean_ret <- colMeans(log_ret_xts)
print(round(mean_ret, 5))

##  ALGO-USD   ETH-USD  LINK-USD MATIC-USD   XMR-USD 
##  -0.00161   0.00035   0.00112   0.00251  -0.00045

cov_mat <- cov(log_ret_xts) * 252
print(round(cov_mat,4))

##           ALGO-USD ETH-USD LINK-USD MATIC-USD XMR-USD
## ALGO-USD    0.8073  0.3888   0.5013    0.5258  0.3450
## ETH-USD     0.3888  0.6062   0.5766    0.4531  0.4725
## LINK-USD    0.5013  0.5766   1.1259    0.5478  0.5037
## MATIC-USD   0.5258  0.4531   0.5478    1.2376  0.3957
## XMR-USD     0.3450  0.4725   0.5037    0.3957  0.6694

wts <- runif(n = length(tick))
wts <- wts/sum(wts)
knitr::kable(wts)

port_returns <- (sum(wts * mean_ret) + 1)^252 - 1
knitr::kable(port_returns)

port_risk <- sqrt(t(wts) %*% (cov_mat %*% wts))
knitr::kable(port_risk)

sharpe_ratio <- port_returns/port_risk
knitr::kable(sharpe_ratio)

num_port <- 5000

all_wts <- matrix(nrow = num_port,
                  ncol = length(tick))

port_returns <- vector('numeric', length = num_port)

port_risk <- vector('numeric', length = num_port)

sharpe_ratio <- vector('numeric', length = num_port)

set.seed(5000)
for (i in seq_along(port_returns)) {
  
  wts <- runif(length(tick))
  wts <- wts/sum(wts)
  
  #store the weights in the matrix
  all_wts[i,] <- wts
  
  #portfolio returns
  port_ret <- sum(wts * mean_ret)
  port_ret <- ((port_ret + 1)^252) - 1
  
  #store the Portfolio Returns values
  port_returns[i] <- port_ret
  
  
  #create and store portfolio risk
  port_sd <- sqrt(t(wts) %*% (cov_mat  %*% wts))
  port_risk[i] <- port_sd
  
  #create and store Portfolio Sharpe Ratios
  #assume a 0% Risk free rate
  sr <- port_ret/port_sd
  sharpe_ratio[i] <- sr
  
}

portfolio_values <- tibble(Return = port_returns,
                           Risk = port_risk,
                           SharpeRatio = sharpe_ratio)
portfolio_values

all_wts <- tk_tbl(all_wts)

## Warning in tk_tbl.data.frame(as.data.frame(data), preserve_index, rename_index,
## : Warning: No index to preserve. Object otherwise converted to tibble
## successfully.

colnames(all_wts) <- colnames(log_ret_xts)

portfolio_values <- tk_tbl(cbind(all_wts, portfolio_values))

## Warning in tk_tbl.data.frame(cbind(all_wts, portfolio_values)): Warning: No
## index to preserve. Object otherwise converted to tibble successfully.

#inspect the first few values
knitr::kable(head(portfolio_values))

min_var <- portfolio_values[which.min(portfolio_values$Risk),]
max_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio),]

p <- min_var %>%
  gather(`ALGO-USD`:`XMR-USD`, key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Minimum Variance Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(p, height = 300, width = 600)

p <- max_sr %>%
  gather(`ALGO-USD`:`XMR-USD`, key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Tangency Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(p, height = 300, width = 600)

p <- portfolio_values %>%
  ggplot(aes(x = Risk, y = Return, color = SharpeRatio)) +
  geom_point() +
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk,
                 y = Return), data = min_var, color = 'red') +
  geom_point(aes(x = Risk,
                 y = Return), data = max_sr, color = 'red') +
  annotate('text', x = 0.32, y = 0.26, label = "Tangency Portfolio") +
  annotate('text', x = 0.21, y = 0.13, label = "Minimum variance portfolio") +
  annotate(geom = 'segment', x = 0.00, xend = 0.00,  y = 0.00, 
           yend = 0.00, color = 'red', arrow = arrow(type = "open")) +
  annotate(geom = 'segment', x = 0.00, xend = 0.00,  y = 0.00, 
           yend = 0.00, color = 'red', arrow = arrow(type = "open"))


ggplotly(p, height = 500, width = 600)