※参考＜統計ソフトRに入力するコマンド＞
統計ソフトRのインストール手順をまとめた記事も作成していますので、よろしければご参考ください。
library(BasketballAnalyzeR)
library(gridExtra)
library(dplyr)
Tbox2526 <- read.csv(file="Tbox_2526.csv")
Obox2526 <- read.csv(file="Obox_2526.csv")
Tadd2526 <- read.csv(file="Tadd_2526.csv")
Pbox2526 <- read.csv(file="Pbox_2526.csv")
dts.PbP.2526 <- read.csv(file="[10-21-2025]-[04-12-2026]-combined-stats.csv")
dts.PbP.2526$player <- sub("^.*/", "", dts.PbP.2526$player)
dts.PbP.2526$converted_x <- NA
dts.PbP.2526$converted_y <- NA
PbP2526 <- PbPmanipulation(dts.PbP.2526)
# Possessions, PACE, Offensive/Defensive Ratings, Four Factors
fourfactors2526 <- fourfactors(Tbox2526, Obox2526)
Playoff <- Tadd2526$Playoff
fourfactors2526PO <- data.frame(fourfactors2526, Playoff)
fourfactors2526PO
# Scatter plot of PACE, Offensive/Defensive Ratings, Four Factors
pa <- ggplot(data=fourfactors2526PO, aes(x=PACE.Off, y=PACE.Def, color = Playoff, label=Team)) +
geom_point() +
ggrepel::geom_text_repel(aes(label = Team))+
geom_vline(xintercept =mean(fourfactors2526PO$PACE.Off))+
geom_hline(yintercept =mean(fourfactors2526PO$PACE.Def))+
labs(title = "PACE - NBA teams (NBA 2025 - 2026 Regular Season)")+
labs(x = "Pace (Possessions per minute) of the Team") +
labs(y = "Pace (Possessions per minute) of the Opponents")
rt <- ggplot(data=fourfactors2526PO, aes(x=ORtg, y=DRtg, color = Playoff, label=Team)) +
geom_point() +
ggrepel::geom_text_repel(aes(label = Team))+
geom_vline(xintercept =mean(fourfactors2526PO$ORtg))+
geom_hline(yintercept =mean(fourfactors2526PO$DRtg))+
labs(title = "ORtg and DRtg - NBA teams (NBA 2025 - 2026 Regular Season)")+
labs(x = "Offensive Rating of the Team (ORtg)") +
labs(y = "Offensive Rating of the Opponents (DRtg)")
f1 <- ggplot(data=fourfactors2526PO, aes(x=F1.Off, y=F1.Def, color = Playoff, label=Team)) +
geom_point() +
ggrepel::geom_text_repel(aes(label = Team))+
geom_vline(xintercept =mean(fourfactors2526PO$F1.Off))+
geom_hline(yintercept =mean(fourfactors2526PO$F1.Def))+
labs(title = "Factor 1: eFG% - NBA teams (NBA 2025 - 2026 Regular Season)")+
labs(x = "eFG% (Offense)") +
labs(y = "eFG% (Defense)")
f2 <- ggplot(data=fourfactors2526PO, aes(x=F2.Off, y=F2.Def, color = Playoff, label=Team)) +
geom_point() +
ggrepel::geom_text_repel(aes(label = Team))+
geom_vline(xintercept =mean(fourfactors2526PO$F2.Off))+
geom_hline(yintercept =mean(fourfactors2526PO$F2.Def))+
labs(title = "Factor 2: TO Ratio - NBA teams (NBA 2025 - 2026 Regular Season)")+
labs(x = "TO Ratio (Offense)") +
labs(y = "TO Ratio (Defense)")
f3 <- ggplot(data=fourfactors2526PO, aes(x=F3.Off, y=F3.Def, color = Playoff, label=Team)) +
geom_point() +
ggrepel::geom_text_repel(aes(label = Team))+
geom_vline(xintercept =mean(fourfactors2526PO$F3.Off))+
geom_hline(yintercept =mean(fourfactors2526PO$F3.Def))+
labs(title = "Factor 3: REB% - NBA teams (NBA 2025 - 2026 Regular Season)")+
labs(x = "REB% (Offense)") +
labs(y = "REB% (Defense)")
f4 <- ggplot(data=fourfactors2526PO, aes(x=F4.Off, y=F4.Def, color = Playoff, label=Team)) +
geom_point() +
ggrepel::geom_text_repel(aes(label = Team))+
geom_vline(xintercept =mean(fourfactors2526PO$F4.Off))+
geom_hline(yintercept =mean(fourfactors2526PO$F4.Def))+
labs(title = "Factor 4: FT Rate - NBA teams (NBA 2025 - 2026 Regular Season)")+
labs(x = "FT Rate (Offense)") +
labs(y = "FT Rate (Defense)")
# Correlation matrix
data2526c <- subset(Pbox2526, MIN>=500)
attach(data2526c)
X <- data.frame(P2M, P3M, FTM, REB=(OREB+DREB), AST, STL, BLK, TOV)/MIN
detach(data2526c)
corrmatrix <- corranalysis(X[,1:8], threshold=0.4)
plot(corrmatrix)
attach(fourfactors2526)
Y <- data.frame(PACE.Off, ORtg, eFGp.Off=F1.Off, TOR.Off=F2.Off, REBp.Off=F3.Off, FTR.Off=F4.Off, PACE.Def, DRtg, eFGp.Def=F1.Def, TOR.Def=F2.Def, REBp.Def=F3.Def, FTR.Def=F4.Def)
detach(fourfactors2526)
corrmatrixY <- corranalysis(Y[,1:12], threshold=0.4)
plot(corrmatrixY)
# Bubble plot of NBA teams
attach(Tbox2526)
X2 <- data.frame(T=Team, P2p, P3p, FTp, AS=P2A+P3A+FTA)
detach(Tbox2526)
labs1 <- c("2-point shots (% made)", "3-point shots (% made)", "free throws (% made)", "Total shots attempted")
bo <- bubbleplot(X2, id="T", x="P2p", y="P3p", col="FTp", size="AS", labels=labs1, title="Bubble plot of NBA teams: Shooting percentage and shots attempted (NBA 2025 - 2026 Regular season)", text.size=3.5)
attach(Tbox2526)
Y2 <- data.frame(T=Team, DREB=DREB/GP, STL=STL/GP, BLK=BLK/GP, PM=PM/GP)
detach(Tbox2526)
labs2 <- c("Defensive Rebounds per Game", "Blocks per Game", "Plus-Minus per Game", "Steals per Game")
bd <- bubbleplot(Y2, id="T", x="DREB", y="BLK", col="PM", size="STL", labels=labs2, title="Bubble plot of NBA teams: Defensive stats and Plus-Minus (NBA 2025 - 2026 Regular season)", text.size=3.5)
# Radar chart of NBA teams
attach(Tbox2526)
T <- data.frame(P2M,P3M, FTM, REB=OREB+DREB, AST, STL, BLK)/MIN
detach(Tbox2526)
radialprofile(data=T, title=Tbox2526$Team, std=TRUE)
listplots <- radialprofile(data=T, title=Tbox2526$Team, std=TRUE)
rc1 <- grid.arrange(grobs=listplots[1:15], ncol=5)
rc2 <- grid.arrange(grobs=listplots[16:30], ncol=5)
# Non-hierarchical clustering - K-means
FF2526 <- fourfactors(Tbox2526, Obox2526)
OD.Rtg <- FF2526$ORtg/FF2526$DRtg
F1.r <- FF2526$F1.Off/FF2526$F1.Def
F2.r <- FF2526$F2.Def/FF2526$F2.Off
F3.Off <- FF2526$F3.Off
F3.Def <- FF2526$F3.Def
P3M <- Tbox2526$P3M
STL.r <- Tbox2526$STL/Obox2526$STL
data2526k <- data.frame(OD.Rtg, F1.r, F2.r, F3.Off, F3.Def, P3M, STL.r)
set.seed(29)
kclu1 <- kclustering(data2526k)
bt <- plot(kclu1)
set.seed(29)
kclu2 <- kclustering(data2526k, labels=Tbox2526$Team, k=4)
plot(kclu2)
kclu2
kclu2.PO <- table(kclu2$Subjects$Cluster, Tadd2526$Playoff)
kclu2.W <- tapply(Tbox2526$W, kclu2$Subjects$Cluster, mean)
Xbar <- data.frame(cluster=c(1:4), N=kclu2.PO[,1], PI=kclu2.PO[,2], PO=kclu2.PO[,3], W=kclu2.W)
bar <- barline(data=Xbar, id="cluster", bars=c("PO","PI","N"), labels.bars=c("Playoff","Playin", "No"), line="W", label.line="average wins", decreasing=FALSE)
cluster <- as.factor(kclu2$Subjects$Cluster)
Xbubble <- data.frame(Team=Tbox2526$Team, PTS=Tbox2526$PTS, PTS.Opp=Obox2526$PTS, cluster, OD.Rtg=data2526k$OD.Rtg)
labs <- c("PTS", "PTS.Opp", "cluster", "OD.Rtg")
kb <- bubbleplot(Xbubble, id="Team", x="PTS", y="PTS.Opp", col="cluster", size="OD.Rtg", labels=labs, title="Bubble plot of NBA teams: PTS, Opponent PTS, Cluster and OD.Rtg (NBA 2025 - 2026 Regular season)", text.size=3.0)
remove(P3M)
# Gini index with respect to PTS and AST
no.teams <- nrow(Tbox2526)
GINI_PTS <- array(0, no.teams)
for (k in 1:no.teams) {
Teamk <- Tbox2526$Team[k]
Pbox2526.sel <- subset(Pbox2526, Team==Teamk)
index1 <- inequality(Pbox2526.sel$PTS, npl=8)
GINI_PTS[k] <- index1$Gini
}
GINI_AST <- array(0, no.teams)
for (k in 1:no.teams) {
Teamk <- Tbox2526$Team[k]
Pbox2526.sel <- subset(Pbox2526, Team==Teamk)
index2 <- inequality(Pbox2526.sel$AST, npl=6)
GINI_AST[k] <- index2$Gini
}
dts <- data.frame(Team=Tbox2526$Team, GINI_PTS, GINI_AST, PTS=Tbox2526$PTS, AST=Tbox2526$AST, Playoff=Tadd2526$Playoff)
gb <- ggplot(data=dts, aes(x=GINI_PTS, y=GINI_AST, color = Playoff, label=Tbox2526$Team)) +
geom_point() +
ggrepel::geom_text_repel(aes(label = Tbox2526$Team))+
geom_vline(xintercept =mean(dts$GINI_PTS))+
geom_hline(yintercept =mean(dts$GINI_AST))+
labs(title = "Scatter plot of NBA teams: Gini index for PTS and AST (NBA 2025 - 2026 Regular season)")+
labs(x = "GINI_PTS") +
labs(y = "GINI_AST")
dts
# Shot chart of all teams
PbP2526rs <- subset(PbP2526, data_set=="NBA 2025-2026 Regular Season") %>%
mutate(
half_x = ifelse(original_x <= 50,
original_x,
100 - original_x),
half_y = ifelse(original_x <= 50,
original_y,
100 - original_y),
xx = (half_y - 50) * 0.5,
yy = half_x * 0.94 - 46.5
)
sc <- shotchart(data=PbP2526rs, x="xx", y="yy", z="playlength", num.sect=5, type="sectors", scatter=FALSE, result="result")
scd <- shotchart(data=PbP2526rs, x="xx", y="yy", type="density-hexbin", nbins=50, palette="bwr")
# Density estimation of field shots of all teams
data2526d <- subset(PbP2526, data_set=="NBA 2025-2026 Regular Season" & result!="" & shot_distance!="")
data2526d$ShotType <- as.character(data2526d$ShotType)
set.seed(1)
data2526r <- data2526d[sample(nrow(data2526d), 10000, replace = FALSE, prob = NULL),]
dd <- densityplot(data=data2526r, shot.type="field", var="shot_distance", best.score=FALSE, title="Density estimation of field shots of all teams, with respect to shot distance (NBA 2025 - 2026 Regular Season), sample: 10000 shots.")
# MDS Map of NBA Players
attach(Pbox2526)
data2526m <- data.frame(P2M, P3M, FTM, REB=(OREB+DREB), AST, STL, BLK)/MIN
detach(Pbox2526)
data2526m <- subset(data2526m, Pbox2526$MIN>=1500)
id <- Pbox2526$Player[Pbox2526$MIN>=1500]
mds <- MDSmap(data2526m)
selp <- which(id=="Shai Gilgeous-Alexander" | id=="LaMelo Ball" | id=="Shai Gilgeous-Alexander" | id=="Donovan Clingan" | id=="Nikola Jokić" | id=="Ausar Thompson" | id=="Victor Wembanyama")
plot(mds, labels=id, subset=selp, col.subset="tomato")
plot(mds, labels=id, subset=selp, col.subset="tomato", zoom=c(-2.5,2.5,-2,2))
plot(mds, z.var=c("P2M", "P3M", "FTM", "REB", "AST", "STL", "BLK"), contour=TRUE, palette=topo.colors)
# Hierarchical clustering - Ward
attach(Pbox2526)
data2526w <- data.frame(PTS, P2M, P3M, REB=(OREB+DREB), AST, TOV, STL, BLK)/MIN
detach(Pbox2526)
data2526w <- subset(data2526w, Pbox2526$MIN>=1800)
ID <- Pbox2526$Player[Pbox2526$MIN>=1800]
hclu1 <- hclustering(data2526w)
hbd <- plot(hclu1)
hclu2 <- hclustering(data2526w, labels=ID, k=8)
plot(hclu2, profiles=TRUE)
dg <- plot(hclu2, rect=TRUE, colored.branches=TRUE, cex.labels=0.2)⇐ 2024-25 |🏀|
※データ分析を実践する際に参考にしている書籍『Basketball Data Science: With Applications in R』の紹介記事も書いていますので、よろしければ下記よりご確認ください。
