Steller STONKS
neoshadow
02/28/2021
Introduction and Purpose
TLDR: Not enough data yet but promising
Calleous Row is a Shadowrun-style roleplay based on VRChat and Homebrew DnD. Found at http://callousrow.com/, it arguably the most famous virtual reality event of 2021 because of the fact many people have had to stay at home and its player cast of famous enterainers, streamers, and artists. Let alone, its a technological innovation in application as the roleplay runs on accelerated AWS instances to host the VRChat Server.
In the futuristic science fiction story, large government-style Mega-Corporations rule have their own https://vrchat-legends.fandom.com/wiki/Mega-corporation_Stock_Market or STONKs for short.
Now relative to other programming languages, modern R is famous for time-series graphs, finacial modeling, and stock market analysis. In fact thanks to many famous founders of modern financial analysis, it is still preferred over python at Bloomberg today because its on the bleeding edge. By contrast Google big query and Tensorflow is currently 2 years behind its financial modeling capabilities that feasts, fable, and other new R packages offering.
So for this Tidy Tuesday R challenge, I thought it might interesting t do some exploratory analysis of the stock market mechanic how similar to fictitious stock market is to the actually thing. You know look at does it have ups/downs? Is it seasonal? Does the STONK market it have an stochastically unpreditable side like the STOCK market? Is it random?
And who know maybe after tracking it for a few weeks, I could officaly submit this.
So enough of an introduction and into looking at STONKS!!
Loading the data
gs4_deauth() #Because public sheet no need for authorization
sheet <- "15vD9ouaLkeAGGglZsskJFTzeX9mBXwsw80zL-XLqkLk"
rawdata <- read_sheet(ss=sheet,skip=1)## Reading from "CallousRowSTONKS"## Range "2:5000000"glimpse(rawdata)## Rows: 11
## Columns: 20
## $ DateTime <dttm> 2020-11-27, 2020-12-04, 2020-12-11, 2020-12-1...
## $ PseudoDate <dttm> 7777-07-01, 7777-07-02, 7777-07-03, 7777-07-0...
## $ Episode <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
## $ Notes <chr> "Please fill this in if you have a source", "P...
## $ Atlantis <dbl> NA, NA, 100.4, 100.4, 100.4, 100.4, 120.4, 120...
## $ Nirvana <dbl> NA, NA, 100.6, 100.6, 100.6, 100.6, 118.6, 118...
## $ Mars <dbl> NA, NA, 100.5, 100.5, 100.5, 100.5, 117.5, 117...
## $ Woto <dbl> NA, NA, 100.3, 100.3, 100.3, 100.3, 120.3, 120...
## $ Quixote <dbl> NA, NA, 100.7, 100.7, 100.7, 100.7, 120.7, 120...
## $ Soniti <dbl> NA, NA, 100.2, 100.2, 100.2, 100.2, 118.2, 118...
## $ Talaris <dbl> NA, NA, 100.8, 100.8, 100.8, 100.8, 120.0, 120...
## $ SAtl <dbl> NA, NA, 0.5, 0.5, 0.5, 0.5, 20.0, 20.0, 18.0, ...
## $ SNir <dbl> NA, NA, 0.1, 0.1, 0.1, 0.1, 10.0, 10.0, 17.0, ...
## $ SMar <dbl> NA, NA, 0.2, 0.2, 0.2, 0.2, 17.0, 17.0, 19.0, ...
## $ SWot <dbl> NA, NA, 0.5, 0.5, 0.5, 0.5, 20.0, 20.0, 20.0, ...
## $ SQuixote <dbl> NA, NA, 0.6, 0.6, 0.6, 0.6, 20.0, 20.0, 16.0, ...
## $ SSon <dbl> NA, NA, 0.4, 0.4, 0.4, 0.4, 18.0, 18.0, 19.0, ...
## $ STal <dbl> NA, NA, 0.8, 0.8, 0.8, 0.8, 20.0, 20.0, 18.0, ...
## $ `Source Link` <chr> NA, NA, "https://www.twitch.tv/videos/84112035...
## $ `Refrence Timestamp` <dttm> NA, NA, 1899-12-30 00:52:59, NA, 1899-12-30 0...The data (link here) is is a combination of the collected data on the https://vrchat-legends.fandom.com/wiki/Mega-corporation_Stock_Market, clips of the Dungeon Master Arcadum, and clips of the player https://www.twitch.tv/lawlman. As you can see though, a few of the early STONK datapoints, so any help would be greatly appreciated. The STONK display board dataset primarily composed of the stocks of the major corporations, like Atlantis, and a respective change in the stock price, like SAtl for Stock Atlantis Price Change. ((Note: Because I don’t how far into the future Callous Row is and exact dates are important for financial analysis, I have had to temporary add artificial date variable called PseudoDate which corresponds to how each episode is 1 day.))
rawdata%>%na.omit()%>%select(DateTime,PseudoDate,Episode,Notes,Atlantis,SAtl)%>%head(7)%>%
rename(`ex. Stock Atlantis`=Atlantis)%>%rename(`ex. Price Change SAtl`= SAtl)%>%
kbl()%>%
kable_paper("hover")| DateTime | PseudoDate | Episode | Notes | ex. Stock Atlantis | ex. Price Change SAtl |
|---|---|---|---|---|---|
| 2020-12-11 | 7777-07-03 | 3 | Lawman stonks comment | 100.4 | 0.5 |
| 2020-01-09 | 7777-07-05 | 5 | IPO Annoucement | 100.4 | 0.5 |
| 2020-01-15 | 7777-07-06 | 6 | Corporations notice market has not changed | 100.4 | 0.5 |
| 2020-01-22 | 7777-07-07 | 7 | IPO Date (Date goes public) | 120.4 | 20.0 |
| 2020-01-29 | 7777-07-08 | 8 | Circuit Breaker Trading Halt | 120.4 | 20.0 |
| 2020-02-19 | 7777-07-10 | 10 | — | 156.4 | 18.0 |
| 2020-02-26 | 7777-07-11 | 11 | Trading Halt | 156.4 | 18.0 |
During the data collection there were several interesting thing I discovered. First the stock market really started on the seventh episode of season 2 when the stock finally became publicly traded and had their IPO (Initial Public Offering). There has also been 2 Trading Halts https://www.investopedia.com/terms/t/tradinghalt.asp since the stock market first started publically trading. In game, the first one make logical sense as a massive sudden influx of buyers/sellers to any market will cause massive volatility; moreover, people have not traded stocks on since the stock market cease eons–why wouldn’t the people in charge put in a circuit breaker for emergencies? This is conveniently is called a Market Circuit Breaker Trading Halt (https://www.investopedia.com/terms/c/circuitbreaker.asp) and you can read more about them here (https://www.npr.org/2020/03/09/813682567/how-stock-market-circuit-breakers-work). Normally these only trigger when things go down though. This bring us to something even odder, there was another trading halt between episode 10 and 11. Most people are probably familiar with the Trading Halts that happened to Game Stop and how Robinhood only partially halted. That sentiment your feeling is how unusual this second halt is as most STONK have been going up. Typically this kind of halt is either market manipulation (Robinhood case) or a sign of soon to be trouble (like many of the crashes). Lets clean this up…
cleandata <- rawdata %>% na.omit() %>% filter(Episode>=6) %>% select(!DateTime) %>%
select(!any_of(c("Notes","Source Link","Refrence Timestamp","Episode"))) %>%
mutate(PseudoDate=as_date(PseudoDate)) %>%
pivot_longer(cols=!PseudoDate,names_to="Name",values_to="Stonks") %>%
#Create a variable to seperate the stocks and change
mutate(VariableType=case_when(
Name %in% c("Atlantis","Nirvana","Mars","Woto","Quixote","Soniti","Talaris") ~ "STONK",
Name %in% c("SAtl","SNir","SMar","SWot","SQuixote","SSon","STal") ~ "Change",
TRUE ~ "Error"))%>%
select(PseudoDate,VariableType,Name,Stonks)
STONKS <- cleandata %>% filter(VariableType=="STONK")%>%select(!VariableType) %>%
as_tsibble(index=PseudoDate,key=Name)
Change <- cleandata %>% filter(VariableType=="Change")%>%rename(Change=Stonks)
STONKS## # A tsibble: 35 x 3 [1D]
## # Key: Name [7]
## PseudoDate Name Stonks
## <date> <chr> <dbl>
## 1 7777-07-06 Atlantis 100.
## 2 7777-07-07 Atlantis 120.
## 3 7777-07-08 Atlantis 120.
## 4 7777-07-10 Atlantis 156.
## 5 7777-07-11 Atlantis 156.
## 6 7777-07-06 Mars 100.
## 7 7777-07-07 Mars 118.
## 8 7777-07-08 Mars 118.
## 9 7777-07-10 Mars 154.
## 10 7777-07-11 Mars 154.
## # ... with 25 more rowsDistribution
First lets look at the reported change in the stocks to se if there is some kind of pattern
descdist(data = Change$Change[Change$Change > 1]-10, discrete=FALSE,1000)
## summary statistics
## ------
## min: 0 max: 10
## median: 8
## mean: 7.785714
## estimated sd: 2.615582
## estimated skewness: -1.887943
## estimated kurtosis: 7.165355#' Descrete case Test
descdist(data = Change$Change[Change$Change > 1], discrete=TRUE,1000)
## summary statistics
## ------
## min: 10 max: 20
## median: 18
## mean: 17.78571
## estimated sd: 2.615582
## estimated skewness: -1.887943
## estimated kurtosis: 7.165355Well there are not enough datapoints to tell (we need about 3 more episodes at least), but it appears to at least not rule out that they are indeed based on a binomial distribution like the probability when you roll a d20.
# fitdistrplus::fitdist(rbinom(n=35,size=20,prob=1/20),distr= "binom",start=list(prob=1/20),
# fix.arg=list(size=20)) %>% plot()
distrmodel <-fitdistrplus::fitdist(Change$Change[Change$Change > 1],distr= "binom",start=list(prob=1/20),
fix.arg=list(size=20))
distrmodel %>% summary()## Fitting of the distribution ' binom ' by maximum likelihood
## Parameters :
## estimate Std. Error
## prob 0.8892876 0.01325838
## Fixed parameters:
## value
## size 20
## Loglikelihood: -70.36861 AIC: 142.7372 BIC: 144.0694distrmodel %>% plot()
This suggestions that its would be closest to a d20+17 or d20+18 (exactly d20+17.6); however, thier is not enough data to be conclusive. At least it probalistics but not completely random like the stock market
Looking at the STONKS, for a distribution pattern.
descdist(data = STONKS$Stonks, discrete=FALSE,1000)
## summary statistics
## ------
## min: 100.2 max: 160.3
## median: 120.4
## mean: 130.0657
## estimated sd: 22.286
## estimated skewness: 0.1081066
## estimated kurtosis: 1.385777Its clear more data is needed.
STONKS PLOTS
I will Fill in explinations later just post code for now as there still needs to be a bit more data.
STONKS %>% select(PseudoDate,Stonks) %>%filter(day(PseudoDate) >= 7)%>% autoplot()## Plot variable not specified, automatically selected `.vars = Stonks`
try(STONKS %>% select(PseudoDate,Stonks) %>% gg_season(period="week"))## Plot variable not specified, automatically selected `y = Stonks`## Error : data contains implicit gaps in time. You should check your data and convert implicit gaps into explicit missing values using `tsibble::fill_gaps()` if required.try(STONKS %>% select(Stonks) %>% gg_season())## Plot variable not specified, automatically selected `y = Stonks`## Error : data contains implicit gaps in time. You should check your data and convert implicit gaps into explicit missing values using `tsibble::fill_gaps()` if required.try(STONKS %>% filter(Name=="Woto")%>% gg_lag(period = "day"))## Plot variable not specified, automatically selected `y = Stonks`## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?
# Predict the STONKs Write up an explination of this later. Basically we can still predict the basics even though we know we are still needing more data.
fit <- STONKS %>% model(arima=ARIMA(Stonks)) ## Warning: 7 errors (1 unique) encountered for arima
## [7] .data contains implicit gaps in time. You should check your data and convert implicit gaps into explicit missing values using `tsibble::fill_gaps()` if required.fit %>% forecast(h=1) %>% filter(Name=="Quixote") %>% autoplot(STONKS)## Warning: Removed 1 rows containing missing values (geom_segment).## Warning: Removed 1 rows containing missing values (geom_segment).## Warning: Removed 1 rows containing missing values.