Overview

This is a wide variety of queries I run to get insights on TopShot data. Many of the resulting tables get output into a sheet in this google doc: https://docs.google.com/spreadsheets/d/1QxHPLv5KObXZX8HzWo2ZkMTcQmmgEgGAzzkmLg4dK8E/edit?usp=sharing

Source

# Load libraries
library(tidyverse)
library(knitr)
library(stringi)
library(nbastatR)
library(googlesheets4)

# Contains some helper functions
setwd("/Users/billy/Dropbox/Data_Science")
source("TS_Functions.R")

# Sets that are often unimportant and to filter out
historicals <- c("Run It Back", "WNBA Run It Back", "Run It Back 2005-06", "NBA All-Star Classics", "Deck the Hoops", "Archive Set", "In Her Bag", "Vintage Vibes", "The Tour", "The Anthology: Magic Johnson", "Archive Set 1986-87", "Run It Back: Legacies 1986-87", "Run It Back 1986-87", "Dynamic Duos")

# Sheet to write outputs so
action781tools <- "https://docs.google.com/spreadsheets/d/1QxHPLv5KObXZX8HzWo2ZkMTcQmmgEgGAzzkmLg4dK8E/edit?usp=sharing"

Load Moments

topshotmoments <- read.csv("https://otmnftapi.com/nbatopshot/create_moments_csv", encoding = "Latin-1") %>% rename(Name = Player.Name)
  
mymoments <- read.csv("https://otmnftapi.com/nbatopshot/create_moments_csv/?user=action781&owned=Show%20Owned&page=1", encoding = "Latin-1") %>% rename(Name = Player.Name)

topshotmoments <- topshotmoments %>% 
    mutate(Name = stri_trans_general(Name, 'latin-ascii')) %>% 
    fix_bball_names() %>% 
    mutate(Tier = factor(Tier, levels = c("Common", "Fandom", "Rare", "Legendary")))
    I
## function (x) 
## {
##     class(x) <- unique.default(c("AsIs", oldClass(x)))
##     x
## }
## <bytecode: 0x1201f7710>
## <environment: namespace:base>
mymoments <- mymoments %>% 
    mutate(Name = stri_trans_general(Name, 'latin-ascii')) %>% 
    fix_bball_names() %>% 
    I

options <- simplify_moments(topshotmoments)

TopShot

TS Offers

offers <- "https://otmnftapi.com/nbatopshot/create_moments_csv/?user=Action781"

offersdata <- read.csv(offers, encoding = "Latin-1") %>% rename(Name = Player.Name)

offers2 <- offersdata %>% 
  filter(League == "NBA") %>% 
  select(Name, Set, Series, Tier, Circulation.Count, Low.Ask, Highest.Offer) %>% 
  mutate(Gap = Low.Ask - Highest.Offer) %>% 
  mutate(Gap.Percent = round(100*Gap/Low.Ask, 1)) %>% 
  arrange(desc(Gap.Percent))

offers2 %>% sheet_write(ss = action781tools, sheet = "offer-deltas")

Play Type Bottlenecks For Each Set

potential_bottlenecks <- topshotmoments %>% 
  filter(Tier %in% c("Common", "Fandom", "Rare")) %>% 
  group_by(Set, Play) %>% summarise(Total_owned = sum(Owned)) %>% 
  arrange(Set, Total_owned)

sheet_write(potential_bottlenecks, ss = action781tools, sheet = "play_type_bottlenecks_by_set")

Rare Team Bottlenecks

rare_bns <- topshotmoments %>% 
  filter(Tier %in% c("Rare")) %>%
  arrange(Team, Low.Ask) %>% 
  select(Name, Set, Tier, Team, Circulation.Count, Low.Ask) %>% 
  arrange(Team, Circulation.Count, Low.Ask)

rare_bns %>% sheet_write(ss = action781tools, sheet = "rare-bns-by-team")

Rare and common rookies badges by team

commonrooks <- topshotmoments %>% filter(Tier %in% c("Common", "Rare")) %>% filter(Rookie.Year == "True") %>% group_by(Team) %>% summarise(sum(Owned))

TSD/Rare/Legendary

rare_or_tsd <- topshotmoments %>% 
  filter(Top.Shot.Debut == "True" | Tier == "Rare" | Tier == "Legendary") %>% 
  filter(Series %in% c("1", "2", "3")) %>% 
  filter(Set %nin% historicals) %>% 
  group_by(Name) %>% summarise(Low.Ask = min(Low.Ask), Max_Mint = sum(Circulation.Count), Owned = sum(Owned), Unlocked = sum(Owned) - sum(Locked)) %>% 
  arrange(Unlocked) %>% 

  I

rare_or_tsd %>% sheet_write(ss = action781tools, sheet = "Rare-Legendary-TSD")
all_rares <- topshotmoments %>% 
  filter(Tier == "Rare") %>% 
  filter(Series %in% c("1", "2", "3")) %>% 
  filter(Set != "Run It Back") %>% 
  group_by(Name) %>% summarise(Low.Ask = min(Low.Ask), Owned = sum(Owned)) %>% 
  I

sum(all_rares$Low.Ask)
## [1] 30025

Rares by team

my_team_rares <- mymoments %>% 
  filter(League == "NBA") %>% 
  filter(Tier == "Rare") %>% 
  group_by(Team) %>% 
  summarise(Low.Ask = min(Low.Ask), Mine_owned = sum(User.Owns.Count))

TSDs by team

my_team_tsds <- mymoments %>% 
  filter(League == "NBA") %>% 
  filter(Top.Shot.Debut == "True") %>% 
  group_by(Team) %>% 
  summarise(Low.Ask = min(Low.Ask) , Mine_owned = sum(User.Owns.Count))

Players I’m missing

allplayers <- topshotmoments %>% 
  filter(Set %nin% historicals) %>% 
  filter(League == "NBA") %>% 
  group_by(Name) %>% 
  summarise(owned = sum(Owned), Low.Ask = min(Low.Ask))

myplayers <- mymoments %>% 
  filter(Set %nin% historicals) %>% 
  filter(League == "NBA") %>% 
  group_by(Name) %>% 
  summarise(mycount = sum(User.Owns.Count))

myplayers2 <- myplayers %>% 
  full_join(allplayers) %>% 
  mutate(mycount = replace_na(mycount, 0)) %>% 
    arrange(mycount, Low.Ask, owned)

Rookie Momes

rookies <- topshotmoments %>% 
  filter(Rookie.Year == "True" & League == "NBA") %>% 
  group_by(Team) %>% 
  summarise(count = sum(Owned), min(Low.Ask), Team) %>% 
  arrange(count) %>% 
  distinct() %>% 
  I
myrookies <- mymoments %>% 
  filter(Rookie.Year == "True") %>% 
  group_by(Team) %>% 
  summarise(mycount = sum(User.Owns.Count), Team) %>% 
  arrange(Team) %>% 
  distinct() %>% 
  I
rarerookies <- topshotmoments %>% 
  filter(Rookie.Year == "True" & League == "NBA" & Tier == "Rare") %>% 
  group_by(Team) %>% 
  summarise(count = sum(Owned), min(Low.Ask), Team) %>% 
  arrange(count) %>% 
  distinct() %>% 
  I

Set Bottlenecks

set_bottlenecks <- topshotmoments %>% 
  filter(League == "NBA") %>% 
  group_by(Set, Series) %>% 
  filter(Circulation.Count == min(Circulation.Count)) %>% 
  select(Name, Set, Series, Circulation.Count, Low.Ask) %>% 
  arrange(Set, Series)

Legendaries by series

totals <- topshotmoments %>% 
  filter(League == "NBA") %>% 
  group_by(Series, Tier) %>% 
  summarise(total = sum(Circulation.Count))
  

totals2 <- totals %>% 
  group_by(Series) %>% 
  summarise(totalall = sum(total))

totals2
## # A tibble: 5 × 2
##   Series totalall
##   <chr>     <int>
## 1 1        904168
## 2 2      15620779
## 3 3      17793088
## 4 4        215845
## 5 S21     1364640
join <- left_join(totals, totals2, by = "Series") %>% 
  mutate(percent = paste(round(100*total/totalall, 2), "%", sep = ""))

join
## # A tibble: 18 × 5
## # Groups:   Series [5]
##    Series Tier         total totalall percent
##    <chr>  <fct>        <int>    <int> <chr>  
##  1 1      Common      772653   904168 85.45% 
##  2 1      Rare        123620   904168 13.67% 
##  3 1      Legendary     7895   904168 0.87%  
##  4 2      Common    15364794 15620779 98.36% 
##  5 2      Rare        245240 15620779 1.57%  
##  6 2      Legendary    10745 15620779 0.07%  
##  7 3      Common    17252575 17793088 96.96% 
##  8 3      Fandom      355824 17793088 2%     
##  9 3      Rare        174529 17793088 0.98%  
## 10 3      Legendary    10160 17793088 0.06%  
## 11 4      Common      142908   215845 66.21% 
## 12 4      Fandom       24755   215845 11.47% 
## 13 4      Rare         45992   215845 21.31% 
## 14 4      Legendary      495   215845 0.23%  
## 15 4      <NA>          1695   215845 0.79%  
## 16 S21    Common      968053  1364640 70.94% 
## 17 S21    Fandom      347087  1364640 25.43% 
## 18 S21    Rare         49500  1364640 3.63%

Team Series & Leaderboards

S1 & Historical

teamseries <- topshotmoments %>% 
  filter(League == "NBA") %>% 
  filter(Series == "1") %>% 
  filter(Set %nin% historicals) %>% 
  group_by(Name, Team, Series) %>% 
  summarise(circ = sum(Owned), Low.Ask = min(Low.Ask)) %>% 
  arrange(Team, Series, circ)

S1_sub_4000 <- teamseries %>% 
  filter(circ < 4000)

#S1_sub_4000 %>% sheet_write(ss = action781tools, sheet = "S1_team_bottlenecks") 

historicalbns <- topshotmoments %>% 
  filter(League == "NBA") %>% 
  group_by(Name, Team) %>% 
  summarise(circ = sum(Circulation.Count), Owned = sum(Owned), Low.Ask = min(Low.Ask)) %>% 
  arrange(Team, circ)

Series Completions

teamdata <- read.csv("https://otmnftapi.com/nbatopshot/create_teams_csv/") %>% 
  select(Team, Price, Completions) %>% 
  separate(Team, into = c("Team", "Series"), sep = " - ") %>% 
  mutate(Series = factor(Series, levels = c("All", "Contemporary", "S1", "S2", "S3"))) %>% 
  slice((1:150)) %>% 
  arrange(Team, Series) %>% 
  I

teamdata %>% sheet_write(ss = action781tools, sheet = "team-series-completions")

Old

Holos

Holos_s3 <- topshotmoments %>% 
  filter(Set %in% c("Holo Icon", "Holo MMXX")) %>% 
  filter(Series %in% c("3")) %>% 
  arrange(Team, Low.Ask) %>% 
  select(Name, Set, Series, Play, Team, Low.Ask, Circulation.Count) %>% 
  I

Holos_by_team <- topshotmoments %>% 
  filter(Set %in% c("Holo Icon", "Holo MMXX")) %>% 
  filter(Series %in% c("1", "2")) %>% 
  arrange(Team, Low.Ask) %>% 
  select(Name, Set, Series, Play, Team, Low.Ask, Circulation.Count) %>% 
  I
Holos_cr <- topshotmoments %>% 
  filter(Set %in% c("Holo Icon", "Holo MMXX")) %>% 
  filter(Challenge.Reward == "True") %>% 
  select(Name, Set, Series, Play, Team, Low.Ask, Circulation.Count) %>% 
  arrange(Circulation.Count) %>% 
  I

S1 counts

S1 <- topshotmoments %>% 
  filter(Series == "1" & Set != "Run It Back") %>% 
  group_by(Name, Team) %>% 
  summarise(count = sum(Owned)) %>% 
  arrange(Team, count)
  I
## function (x) 
## {
##     class(x) <- unique.default(c("AsIs", oldClass(x)))
##     x
## }
## <bytecode: 0x1201f7710>
## <environment: namespace:base>

Non base

nonbase <- topshotmoments %>% 
  filter(Set %nin% c("Base Set")) %>% 
  group_by(Name) %>% summarise(Owned = sum(Owned), Low.Ask = min(Low.Ask)) %>% 
  arrange(Owned, Low.Ask)

TSD

all_tsds <- topshotmoments %>% 
  filter(Tier == "Common") %>% 
  filter(Top.Shot.Debut == "True") %>% 
  filter(Series %in% c("1", "2", "3")) %>% 
  filter(Set != "Run It Back") %>% 
  group_by(Name) %>% summarise(Low.Ask = min(Low.Ask), Owned = sum(Owned), Circulation = sum(Circulation.Count)) %>% 
  I

sum(all_tsds$Low.Ask)
## [1] 26623

CRs

all_CR <- topshotmoments %>% 
  filter(Challenge.Reward == "True") %>% 
  group_by(Play) %>% summarise(count_CR = n()) %>% 
  mutate(proportion_CR = count_CR / sum(count_CR)) %>% 
  I

all_momes <- topshotmoments %>% 
  group_by(Play) %>% summarise(count_all = n()) %>% 
  mutate(proportion_all = count_all / sum(count_all)) %>% 
  I

play_type_cr <- left_join(all_CR, all_momes)

Archives

archive1 <- topshotmoments %>% 
  filter(Set == "Archive Set") %>%
  group_by(Team) %>% 
  summarise(Owned = sum(Owned)) %>% 
  arrange(Owned)
        
archive2 <- topshotmoments %>% 
  filter(Set == "Archive Set") %>%
  group_by(Play) %>% 
  summarise(Owned = sum(Owned)) %>% 
  arrange(Owned)

RIBs

allribs <- topshotmoments %>% 
  filter(Set %in% c("Run It Back", "Run It Back 2005-06"))
rib <- topshotmoments %>% filter(Set == "Run It Back 2005-06") %>% mutate(xpx = In.Packs.Others*Low.Ask)

sum(rib$xpx)/sum(rib$In.Packs)
## [1] 80.50498

Lockerroom

lockerroom <- topshotmoments %>% 
  filter(Set == "Base Set" & Series == "3" & Circulation.Count == 60000 & Team %in% playoffs) %>% 
  group_by(Name) %>% summarise(`60k.Low.Ask` = min(Low.Ask), `60k.minted` = sum(Circulation.Count), `60k.Owned` = sum(Owned), `60k.In.Packs` = sum(In.Packs.Others), `60k.In.LockerRoom` = sum(Locker.Room)) %>% 
  arrange(`60k.Owned`)

allcircs <- topshotmoments %>% 
  filter(Set %nin% c("In Her Bag", "Run It Back", "WNBA Run It Back", "Run It Back 2005-06", "NBA All-Star Classics", "Deck the Hoops")) %>% 
  group_by(Name) %>% summarise(Total.Player.Supply = sum(Owned))

lockerroom2 <- lockerroom %>% 
  left_join(allcircs) %>% 
  arrange(Total.Player.Supply) %>% 
  mutate(Percent.In.Lockerroom = `60k.In.LockerRoom`/(`60k.In.LockerRoom`+`60k.Owned`))