[SL] Natural Cubic Splines

碰到需要作預測、分類等分析時，在沒什麼限制的狀況下，通常會先考慮一個簡單並且容易解釋分析結果的方法，
再去依照分析結果與探索性資料分析的結果，互相比對進行優化，所以像 Linear Regression, Logistic Regression 這類線性加法模型，算是最常用的分析方法。

由於使用 $X$ 的線性組合表達方式，使得解釋起來較為清楚易懂；同時在變數數量很多，資料數量偏少 (n小p大) 的情況，
這類模型往往比較容易能夠避開 Overfitting 的情況(或採用 Penalization, Stepwise Selection等方式)。

但有時候現實資料中，$Y$ 與 $X$ 常常不是一個線性的關係，基本上在散佈圖中可以大概看出 $Y$ 跟 $X$ 之間是否具有非線性的關係，
配適線性模型後，根據殘差判斷是否需要加入其他項次，一個個加入 $X$ 的多項式項與交互作用項，最後反覆根據殘差進行相對應的調整。

也因為上述，若要一個個調整，放入 $X$ 的多項式項會是很頭大的一件事情，所以發展出能夠自動配適非線性關係的 Generalized Additive Models (GAM) 。

GAM 簡單的說，就是把每一個 $X$ 先表示成一個不預先定義的平滑函數線性組合，假設真實模型為 $Y=X^{2}$ ，若令一函數 $g(X)=X^{2}$ ，真實模型可寫成 $Y=g(X)$，
但現實中，我們不知道 $g(X)$ 的真實函數表達式為 $X^{2}$，因此我們使用近似函數 $\hat{g}(X)$ 來替代 $X^{2}$，$\hat{g}(X)$ 這個函數我們利用多項式的 Basis 與 $X$ 進行線性組合來近似，
並且這個近似的函數會保有連續、平滑、可二次微分等良好的性質。

本篇主題 Natural Cubic Splines 即是一個近似的方法，當然還有其他像 B-Spline 等各有優缺點的近似方法，待後續再作討論。


$$N_{1}(X)=1, N_{2}(X)=X, N_{k+2} (X)=d_{k} (X) - d_{K-1} (X)$$
$$d_{k}(X)=\frac{(X-\xi_{k})^{3}_{+}-(X-\xi_{K})^{3}_{+}}{\xi_{K}-\xi_{k}}$$

Natural Cubic Spline for Sepal.Width (y) ~ Sepal.Length (x)

	## Data
	y=iris$Petal.Width
	x=iris$Petal.Length
	## Set Basis Knots
	knot=seq(2,6,1)
	K=length(knot)
	n1=rep(1,length(x))
	n2=x
	n3=d(knot[1],knot[K],x)-d(knot[(K-1)],knot[K],x)
	n4=d(knot[2],knot[K],x)-d(knot[(K-1)],knot[K],x)
	n5=d(knot[3],knot[K],x)-d(knot[(K-1)],knot[K],x)
	## d_K Function
	d=function(ck,cK,x){
	dkx={0}
	for ( i in 1:length(x) ){
	fir=ifelse(x[i]>ck,(x[i]-ck)^3,0)
	sec=ifelse(x[i]>cK,(x[i]-cK)^3,0)
	dkx[i]=(fir-sec)/(cK-ck)
	}
	return(dkx)
	}
	## Basis
	N=cbind(n1,n2,n3,n4,n5)
	## Get beta_hat from OLS
	bhat = solve(t(N)%*%N)%*%t(N)%*%y
	## Give any x in domain for x
	prex=seq(1.5,6.5,0.5)
	## Sub prex to the same basis
	pren1=rep(1,length(prex))
	pren2=prex
	pren3=d(knot[1],knot[K],prex)-d(knot[(K-1)],knot[K],prex)
	pren4=d(knot[2],knot[K],prex)-d(knot[(K-1)],knot[K],prex)
	pren5=d(knot[3],knot[K],prex)-d(knot[(K-1)],knot[K],prex)
	preN=cbind(pren1,pren2,pren3,pren4,pren5)
	## pre = sum_i beta_hat * h(x_i)
	pre=as.vector(t(bhat) %*% t(preN))
	plot(x,y)
	lines(x=prex,y=pre)

view raw gistfile1.txt hosted with ❤ by GitHub

[Kaggle] Kobe Bryant Shot Selection - (1) 探索性資料分析

這次選擇的 Kaggle 主題是 : 預測 Kobe Bryant 是否會進球
https://www.kaggle.com/c/kobe-bryant-shot-selection

在 Training Data 中，要預測的變數 : shot_made_flag 是一個二元值，1 代表進球，0 代表沒進
要注意的小提示是，這次比賽採 Logarithmic Loss ，如果你的預測結果是一個二元值，例如：預測為進球 ( 1 ) ，實際是沒進 ( 0 )，那麼基於這種 Loss Function 會給予無限大的懲罰，
所以在 Leaderboard 上看到的分數有兩種情況，一種是 1 以下，一種是 10 以上，基本上是產出的 Test Data 是在 0 ~ 1 範圍之間變動的值還是 0 , 1 二元值的差別，如果實際上你希望得到高分，
應該變成是要預測基於 Kobe 這樣的投籃，投進的機率應該是多少XD

關於 Kaggle 中對於 Logarithmic Loss 的定義與解釋如下：
https://www.kaggle.com/wiki/LogarithmicLoss

這次競賽利用的是 Kobe 生涯投籃的相關數據，主要比較多類別型的變數，轉貼 Kaggle 的變數內容如下：

The field names are self explanatory and contain the following attributes:

action_type
combined_shot_type
game_event_id
game_id
lat
loc_x
loc_y
lon
minutes_remaining
period
playoffs
season
seconds_remaining
shot_distance
shot_made_flag (this is what you are predicting)
shot_type
shot_zone_area
shot_zone_basic
shot_zone_range
team_id
team_name
game_date
matchup
opponent
shot_id

(1) 資料整理

大概了解資料後，就可以先把資料載入：

	library(dplyr)
	library(magrittr)
	library(ggplot2)
	d=read.table("~path/data.csv",sep=",",header=T,stringsAsFactor=F)

view raw gistfile1.txt hosted with ❤ by GitHub

先對資料進行以下的整理：

1. Kobe 只待過 Lakers ，所以可以把 team_id, team_name 變數忽略掉。
2. 由於 matchup 包含主/客場以及交手球隊，但 opponent 就有交手球隊，所以用一個 home_type 變數把 matchup 主 (1)、客 (2) 場的狀態標示出來就好。
3. 球場座標標示有兩種 lat, lon 與 loc_x, loc_y ，兩種似乎是差不多的意思，在這裡選擇精度看起來較高的 lat, lon。
4. 資料內分別有 minutes_remaining, seconds_remaining 與其對應的節數( periods )，用一個 remain_sec 變數將這兩個變數合併成：這節剩下幾秒。
5. 把 game_date 改成 Date 格式物件，方便查詢。
6. 最後把 Training Data 與 Test Data 切開，留下 Training Data 作探索性資料分析 ( EDA )。

	d %<>% mutate(home_type=ifelse(grepl("@",matchup),2,1),
	remain_sec=minutes_remaining*60+seconds_remaining,
	game_date=as.Date(game_date)) %>%
	select(-team_id,-team_name,-loc_x,-loc_y,-minutes_remaining,-seconds_remaining,-matchup)
	trd=d %>% filter(is.na(shot_made_flag)==FALSE)
	ted=d %>% filter(is.na(shot_made_flag)==TRUE)

view raw gistfile1.txt hosted with ❤ by GitHub

由於原始資料中有很多類別型的變數，檢查一下有沒有 Test Data 有的 Level 但 Training Data 沒有 :

	NotInTrainListL=list()
	j=0
	for( i in which(sapply(d,class)=="character") ){
	CheckV=unique(ted[,i])[unique(ted[,i]) %in% unique(trd[,i])==FALSE]
	if( length(CheckV) > 0 ){
	j=j+1
	NotInTrainListL[[j]]=CheckV
	names(NotInTrainListL)[j]=names(trd)[i]
	}
	}
	# > NotInTrainListL
	# $action_type
	# [1] "Turnaround Fadeaway Bank Jump Shot" "Cutting Finger Roll Layup Shot"

view raw gistfile1.txt hosted with ❤ by GitHub

發現 Test Data 中只有 action_type 具有兩種情形不在 Training Data 中，但資料筆數不多 (2筆)，若 action_type 為一個具有顯著影響力的變數，後續可以試試看與這兩筆差不多的資料進行預測。
例如 : Turnaround Fadeaway Bank Shot 在 Combined_shot_type 變數屬於 Jump Shot, shot_distance 變數為 14，即可用這些資訊進行 shot_made_flag 的預測。

(2) 探索性資料分析

(2-1) 各種 combined_shot_type 的比例   (2-2) 各種 combined_shot_type 下的命中率

Kobe 的出手以 Jump Shot 為主，佔了約 76.7%，命中率為 39.1%，為所有出手種類命中率最低的。
Dunk, Layup, Jump Shot 三種佔多數的出手種類，投籃命中率分別為 92.8%, 56.5%, 39.1% ，上述與在正常投籃狀況下大致相符，投籃命中率隨著與籃框的距離而增減。

比較有趣的是 Bank Shot 雖僅佔出手次數的 0.5% ，但命中率為令人意外的 79.2% (Tim Duncan表示XD)，而 Hook Shot 也有超過 50% 的命中率，待後續與投籃距離、座標、兩/三分球等進行比較。

(2-3) 各種 combined_shot_type 下，action_type 的比例

(2-4) 各種 combined_shot_type, action_type 下的命中率

接下來看分類較細的 action_type ，圖(2-3)、圖(2-4)上方，以每項 combined_shot_type 進行分類，括號內代表此 combined_shot_type 佔所有 Training Data 的比例，也對應到圖(2-1)。

圖(2-3)內的每一長條代表此 combined_shot_type 之下，此 action_type 所佔的比例與數量；圖(2-4)內的每一長條代表此 action_type 之下，出手進球的比例。

可以發現 Kobe 在各種 combined_shot_type 之下，約有 1 ~ 3 種習慣出手的方式，
與一般印象不同的是， Fadeaway Jump Shot 的數量僅 872 次，佔 Jump Shot 數量的 4.4% 而已。
並且以飛人球員的形象來看， Layup 與 Dunk 的變化好像也不多，不過看起來應該是有足夠在空中的 Drive 就不需要其他多餘的花招破壞美感XD

另外可以發現，有些 action_type 雖然出手的次數少，但命中率卻相當高，例如 : Hook Bank Shot, Running Slam Dunk Shot, Reverse Slam Dunk Shot, Turnaround Finger Roll shot,
Driving Floating Bank Jump Shot 等命中率都為 100%  (怎麼感覺越難的越會進阿XD)，
Bank Shot 的命中率也皆有超過 50% 的命中率，像是上述提到的 Driving Floating Bank Jump Shot 與 Fadeaway Bank Shot 在 Jump Shot 裡都是命中率很高的類別。

另外出手次數較多且較基本的動作，像是 Jump Shot, Layup Shot, Hook Shot 等，命中率僅 3 成左右；Tip Shot 比較可以猜的出來，是因為點球這種需要靠手感及瞬間反應的動作，命中率會較低。

除了上述談到的基本動作命中率之外，其他動作的出手數雖然較少，大部份都有超過 50% 的水準，因此的確可以看出 action_type 與命中率是有一些關係的。

(2-5) 各 shot_zone_area 與 shot_zone_basic 的命中率

圖(2-5) 將投籃方位 (shot_zone_area) 與投籃位置 (shot_zone_basic) 合併在一起看，繪出 Kobe 在各個出手位置的出手散佈圖，並且將各個位置的命中率(命中次數/出手次數)列於圖中。

可以發現球場右半邊的出手次數較左半邊來的多，但是在三分線內，球場左右邊各相對位置之間的命中率差異不大，
命中率差異較多的在左右側油漆區 Left Side(L) & In The Paint(Non-RA) : 41.3% 與 Right Side(R) & In The Paint(Non-RA) : 48.1% ，右邊投籃次數及命中率較高；
而在三分線的命中率，可以發現在兩側底角 Left Side(L) & Left Corner 3 : 37.1% 與 Right Side(R) & Right Corner 3 : 33.9 % ，左邊命中率較高，與油漆區相反，
三分線的弧頂位置，命中率由左至右逐漸升高，而距離較遠延伸至中、後場的命中率則僅命中一球。

在此以 Two Sample Chi-Squared Independence Test 雙尾檢定上述之 (1) 左右側油漆區命中率 (2) 三分線兩側底角命中率 是否有顯著差異，顯著水準($\alpha$)訂為0.05。
$H_{0} : P_{1}=P_{2}$，檢定結果 : (1) p-Value=0.07902, (2) p-Value=0.4903 ，兩者皆無顯著證據證明投籃命中率不一。

	trd %>% filter(shot_zone_area %in% c("Left Side(L)","Right Side(R)") & shot_zone_basic %in% c("Left Corner 3","Right Corner 3") ) %>% mutate(g=paste0(shot_zone_area," & ",shot_zone_basic)) %>% select(g,shot_made_flag) %>% table %>% chisq.test
	trd %>% filter(shot_zone_area %in% c("Left Side(L)","Right Side(R)") & shot_zone_basic == "In The Paint (Non-RA)" ) %>% mutate(g=paste0(shot_zone_area," & ",shot_zone_basic)) %>% select(g,shot_made_flag) %>% table %>% chisq.test

view raw gistfile1.txt hosted with ❤ by GitHub

根據 Wiki，從 1997-98 賽季開始，NBA的三分線離籃框水平距離，於角落為 22呎，其他區域為 23呎9吋。
首先將 shot_zone_range 與 shot_type 對應，可以發現幾筆比較有疑問的資料，分別在以下列出。
shot_id : 5251, 9104 這兩筆投籃距離分別為 50, 26 但 shot_type 皆為 2PT Field Goal；
shot_id : 14513, 22905 這兩筆投籃距離分別為 9, 0 但 shot_type 皆為 3PT Field Goal。

接著將 shot_zone_range 與 shot_distance 對應， shot_zone_range 有以下幾種距離分類 : Less Than 8 ft, 8-16ft, 16-24ft, 24+ ft, Back Court Shot ，
但在資料中可以發現這幾種距離分類與 shot_distance 在 Interval Boundary 上面會有一些問題，例如 :
shot_distance 為 8, 會出現在 shot_zone_range 為 Less Than 8 ft(4), 8-16ft(564)；
shot_distance 為 16, 會出現在 shot_zone_range 為 8-16ft(2), 16-24ft(1163)；
shot_zone_range 為 24+ ft，但 shot_distance 為 22(161), 23(374), 24(1263)。

針對資料有些許品質問題的情形，例如 : 遺失值、異常值等，一般而言，會先了解資料形成的原因，才可以判斷下一步進行修改、補值或刪去等動作，
反之，若無法了解形成原因，若這些資料相對稀少，通常會採取較安全的作法，先將這些資料進行篩選、移出 Training Data，待後續了解原因後再對這些資料進行判斷。
那如果這些資料蠻多的呢? 那就需要更深入的將資料圖表化，進一步判斷這是不是一個資料品質問題，還是資料就是從這些分布所取得的。

在這邊我們雖然知道 shot_id : 5251, 9104 的 shot_type 應該是 3PT Field Goal, 而 shot_id : 14513, 22905 的 shot_type 應該是 2PT Field Goal，
但是這應該牽涉到記錄問題，我們並不知道是否記錄錯誤，並且這樣的資料數量相對於整個 Training Data 相對稀少 (4/25697)，因此考慮移出 Training Data。
而 shot_zone_range 為一個區隔不同距離的變數，由資料上來看，shot_distance 為 8 應該是被放在 8-16ft. 裡，也就是 $8 \leq x < 16$ 這樣的區間；
使用有些分析方法時，例如 : Classification and Regression Tree (CART) ，這類使用 Gini Index 作為估計不純度( Impurity )的方法，
會因為上述 shot_zone_range 的 Level 標示不一致，導致篩選重要性變數的機制會有些許問題，對整體模型造成影響。

但在本篇分析中，由於我們不確定資料異常原因，也不確定資料定義是否如預期，因此我會先標註這些具有異常資料的情形，於後續模型優化時再考慮修正。

(2-6) 各 shot_distance 的命中率

圖 (2-6) 顯示各 shot_distance 之下的命中率，可以發現 Kobe 的命中率隨著距離逐漸減低，
從圖中，依命中率可區分為五大群 (1) 0 ft. ~ 2 ft. (2) 3 ft. ~ 15 ft. (3) 16 ft. ~ 21 ft. (4) 22 ft. ~ 25 ft. (5) 25 ft. +
其中在 3 ft. ~ 15 ft. 之間，命中率雖會隨著距離的增加而下降，但有些距離的命中率卻是突然飆高的，例如 4 ft., 8 ft., 11 ft., 12ft. 等，
由投籃次數來看，超過 1000 次出手的距離有 16 ft. ~ 19 ft., 24 ft. ~ 26 ft.，顯示 Kobe 偏好在中長程距離出手。

(2-7) combine_shot_type 為 Jump Shot 之下，前 3 個 action_type 類別命中率與距離的比較。

由上述提到，combined_shot_type 為 Jump Shot 佔了總出手次數的 76.7%，而在此之下的前三個 action_type : Jump Shot, Turnaround Shot, Fadeaway Jump Shot 佔了這些出手次數近 90%，
因此，圖 (2-7) 顯示在各 shot_distance 下，這些 action_type 的命中率，值得注意的是，根據上述，出手命中率會隨著距離而降低，
但 Jump Shot 的命中率由 3 ft. 的 21% 開始，隨著距離增加逐漸攀升至 21 ft. 的 40% 才開始滑落至 22 ft. 的 35% 以下；
Turnaround Jump Shot 與 Fadeaway Jump Shot 大多數的出手集中在 3 ft. ~ 21ft.，皆有 50% 左右的命中率，在 8 ft. 也有超過 70% 的命中率。
投籃次數最多的落在 14 ft. ~ 16 ft. 之間，在 15 ft. 的 Fadeaway Jump Shot 有超過 60% 的命中率，
可以看出 Kobe 的 Jump Shot 在中長程距離的命中率並不太會隨著距離增加所影響，並且 Fadeaway 及 Turnaround 的動作對命中率有所提高。

(2-8-1) 各季出手次數與 shot_type 比率

(2-8-2) 各季 shot_type 命中率

圖 (2-8-1)、(2-8-2) 分別繪出對於每季的 shot_type 與命中率，比較有趣的有以下幾點：

1. 2PT Field Goal 生涯出手比例約佔 75 % 左右，生涯晚期 2014-15, 2015-16 賽季 3PT Field Goal 出手比例較多。
2. 生涯 2PT Field Goal 命中率差異不大，命中率約落在 45% - 50% 左右，不大會隨著出手次數多而明顯降低，但 2013-14 賽季後，明顯出手命中率降低至 41% 左右。
3. 生涯 3PT Field Goal 命中率從 2010-11 降到約 30% 左右的命中率便逐漸維持這樣的命中率；但隨著 2015-16 賽季 3PT Field Goal 出手比例較多，但命中率僅 28.4% ，得分效率就會明顯與過去有落差。

對照 Kobe 的 維基百科： https://zh.wikipedia.org/wiki/%E7%A7%91%E6%AF%94%C2%B7%E5%B8%83%E8%8E%B1%E6%81%A9%E7%89%B9
Kobe 在 2003 - 2005 期間經歷了個人與球隊的低潮，因此出手及出賽次數較低，但僅 2003-04 的 3PT Field Goal 命中率較低，為 30.5%。
在 2013-14 賽季阿基里斯腱受傷及 2014-15 受傷後，也反應在他的命中率上。

(2-9) 年份分群下，各節剩餘時間之命中率

由圖 (2-8-1)以及維基百科 ，將 Kobe 的生涯分成 5 群，分別為 ： "1996 - 99", "1999 - 04", "2004 - 07", "2007 - 13", "2013 - 16"，也就是新人時期、湖人 OK 三連霸與 F4 時期、 81 分時期、 Gasol & Howard 時期 、大傷至退休時期，以上 5 個時期進行比較。

	themep=theme(
	plot.title=element_text(face="bold",size=18),
	legend.title=element_text(size=16),
	legend.text=element_text(size=14),
	axis.title.x=element_text(size=14),
	axis.title.y=element_text(size=14),
	axis.text.x=element_text(size=12),
	axis.text.y=element_text(size=12)
	)
	## 2-1, 2-2
	p1=trd %>% group_by(combined_shot_type) %>% summarise(p=round(n()/nrow(trd),3)*100) %>% arrange(p) %>% ungroup %>% mutate(pos=cumsum(p)-0.5*p) %>%
	ggplot(.,aes(x="",y=p,fill=combined_shot_type))+
	geom_bar(width=1,stat="identity")+
	coord_polar(theta="y")+
	geom_text(aes(y=pos,label=c("","","",paste0(p[4:6],"%"))),size=6,fontface="bold")+
	scale_fill_discrete(name="combined_shot_type",labels=c("Bank Shot ( 0.5% )","Dunk","Hook Shot ( 0.5% )","Jump Shot","Layup","Tip Shot ( 0.6% )"))+
	ggtitle("(2-1) The Proportion of combined_shot_type")+
	theme_minimal()+
	theme(
	plot.title=element_text(face="bold",size=18),
	axis.title.x=element_blank(),
	axis.title.y=element_blank(),
	panel.grid=element_blank(),
	axis.text=element_blank(),
	legend.title=element_text(size=16),
	legend.text=element_text(size=14)
	)
	p2=trd %>% group_by(combined_shot_type,shot_made_flag) %>% tally %>% group_by(combined_shot_type) %>% mutate(p=round(n/sum(n),3)*100) %>%
	ggplot(.,aes(x=combined_shot_type,y=p,fill=factor(shot_made_flag)))+
	geom_bar(stat="identity",position="dodge")+
	geom_text(aes(label=paste0(p,"%")),position=position_dodge(width=0.9),size=4,colour="white",vjust=1,fontface="bold")+
	scale_fill_discrete(name="shot_made_flag",breaks=c("0","1"),labels=c("Failed","Made"))+
	ggtitle("(2-2) The Field Goal (%) of combined_shot_type")+
	ylab("Proportion")+
	themep
	gridExtra::grid.arrange(p1,p2,nrow=1)
	## 2-3
	combined_pro=trd %>% group_by(combined_shot_type) %>% summarise(p=round(n()/nrow(trd),3)*100) %>% arrange(p) %>% mutate(name=paste0(combined_shot_type," ","(",p,"%)"))
	ComProbD=trd %>% group_by(combined_shot_type,action_type) %>% tally %>%
	group_by(combined_shot_type) %>% mutate(p=round(n/sum(n),3)) %>% ungroup %>%
	mutate(combined_shot_type=factor(combined_shot_type,levels=combined_pro$combined_shot_type,labels=combined_pro$name)) %>%
	arrange(desc(combined_shot_type),desc(n)) %>%
	mutate(action_type=factor(action_type,levels=action_type))
	ggplot(data=ComProbD,aes(x=action_type,y=p,fill=combined_shot_type))+
	facet_grid(.~combined_shot_type,space="free")+
	geom_bar(stat="identity")+
	geom_text(aes(y=0.65,label=paste0(p*100,"% (",n,")")),colour="black",size=3,fontface="bold",hjust=0)+
	scale_fill_discrete(name="combined_shot_type",breaks=combined_pro$name,labels=combined_pro$combined_shot_type)+
	scale_y_continuous(breaks=seq(0,1,0.25),labels=paste0(seq(0,100,25),"%"))+
	ggtitle("(2-3) The Proportion of action_type categorized by combined_shot_type")+
	ylab("Proportion")+
	theme(
	axis.text.x=element_text(angle=90,hjust=1),
	strip.text.x=element_text(size=14,face="bold")
	)+
	themep+
	coord_flip()
	## 2-4
	trd %>% group_by(combined_shot_type,action_type,shot_made_flag) %>% tally %>%
	group_by(combined_shot_type,action_type) %>% mutate(p=round(n/sum(n),3)) %>% ungroup %>%
	mutate(combined_shot_type=factor(combined_shot_type,levels=combined_pro$combined_shot_type,labels=combined_pro$name),
	action_type=factor(action_type,levels=levels(ComProbD$action_type))) %>%
	arrange(desc(combined_shot_type),action_type,desc(shot_made_flag),desc(p)) %>%
	group_by(combined_shot_type,action_type) %>% mutate(loc=cumsum(p)-p/2) %>% ungroup %>%
	ggplot(aes(x=action_type,y=p))+
	facet_grid(.~combined_shot_type,space="free")+
	geom_bar(aes(fill=factor(shot_made_flag)),stat="identity")+
	geom_text(aes(y=loc,label=paste0(p*100)),size=4,fontface="bold")+
	scale_fill_discrete(name="shot_made_flag",breaks=c(0,1),labels=c("Missed","Made"))+
	scale_y_continuous(breaks=seq(0,1,0.25),labels=paste0(seq(0,100,25),"%"))+
	ggtitle("(2-4) The Field Goal (%) of action_type categorized by combined_shot_type")+
	ylab("Proportion")+
	theme(
	axis.text.x=element_text(angle=90,hjust=1),
	strip.text.x=element_text(size=14,face="bold")
	)+
	themep+
	coord_flip()
	## 2-5
	new_area_p=trd %>% mutate(new_area=paste0(shot_zone_area," & ",shot_zone_basic)) %>% group_by(new_area) %>% summarise(total=n(),made=sum(shot_made_flag),p=round(sum(shot_made_flag)/n(),3))
	new_area_loc=trd %>% mutate(new_area=paste0(shot_zone_area," & ",shot_zone_basic)) %>% group_by(new_area) %>% summarise(medlat=median(lat),medlon=median(lon))
	new_area_merge=left_join(new_area_p,new_area_loc,"new_area"="new_area") %>% mutate(madelabel=paste0(p*100,"%","\n"," (",made,"/",total,")"))
	trd %>% mutate(newarea=paste0(shot_zone_area," & ",shot_zone_basic)) %>%
	ggplot(aes(y=lat,x=lon,colour=factor(newarea)))+
	geom_point()+
	annotate("text",y=new_area_merge$medlat,x=new_area_merge$medlon,label=new_area_merge$madelabel,size=5,fontface="bold")+
	scale_colour_discrete(name="shot_zone_area & shot_zone_basic")+
	ylab("Latitude")+
	xlab("Longitude")+
	ggtitle("(2-5) The Field Goal (%) of shot_zone_area & shot_zone_basic")+
	themep
	## 2-6
	ShotText=trd %>% mutate(DisLevel=ifelse(shot_zone_area=="Back Court(BC)","BC",shot_distance)) %>% group_by(DisLevel) %>% tally
	ShotTextV=paste0(ShotText$DisLevel,"(",ShotText$n,")")
	names(ShotTextV)=ShotText$DisLevel
	p261=trd %>% mutate(DisLevel=ifelse(shot_zone_area=="Back Court(BC)","BC",shot_distance)) %>% group_by(DisLevel) %>% summarise(n=n(),m=sum(shot_made_flag),p=m/n) %>%
	ggplot(aes(x=factor(DisLevel,levels=c("BC",45:0)),y=p))+
	geom_bar(stat="identity")+
	geom_text(aes(y=p,label=paste0(round(p,3)*100,"% (",m,"/",n,")")),size=4,fontface="bold",hjust=0)+
	coord_flip()+
	ylab("Proportion")+
	xlab("shot_distance")+
	ggtitle("(2-6) The Field Goal (%) of shot_distance")+
	scale_y_continuous(limits=c(0,0.75),breaks=seq(0,0.7,0.1),labels=paste0(seq(0,70,10),"%"))+
	themep
	ShotDistanceText=trd %>% filter(shot_distance %in% c(2,8,15,21,25)) %>% group_by(shot_distance) %>% summarise(minlat=min(lat),meanlon=mean(lon))
	ColorV=c("grey",rep("red",5))
	names(ColorV)=c(1,2,8,15,21,25)
	p262=trd %>% mutate(PointColour=ifelse(shot_distance %in% c(2,8,15,21,25),shot_distance,1))%>%
	ggplot(aes(y=lat,x=lon,colour=factor(PointColour)))+
	geom_point()+
	annotate("text",y=ShotDistanceText$minlat,x=ShotDistanceText$meanlon,label=paste0(ShotDistanceText$shot_distance," ft."),size=6,fontface="bold")+
	scale_colour_manual(name="",values=ColorV)+
	xlab("Longitude")+
	ylab("Latitude")+
	theme(legend.position="none")+
	themep
	layoutM26=matrix(c(1,1,2,2,2,2,1,1,2,2,2,2),nrow=2,ncol=6,byrow=T)
	gridExtra::grid.arrange(p262,p261,layout_matrix=layoutM26)
	##2-7
	trd %>% filter(action_type %in% c("Jump Shot","Turnaround Jump Shot","Fadeaway Jump Shot"),shot_distance<30) %>% group_by(shot_distance,action_type) %>%
	summarise(n=n(),m=sum(shot_made_flag),p=m/n) %>%
	ggplot(aes(x=shot_distance,y=p,colour=action_type))+
	geom_line(size=2)+
	geom_text(aes(label=n,group=n),colour="black",size=5,fontface="bold")+
	ggtitle("(2-7) The Field Goal (%) of the top 3 major action_type by combined_shot_type of Jump Shot")+
	ylab("Proportion")+
	scale_x_continuous(breaks=seq(0,30,1),labels=seq(0,30,1))+
	scale_y_continuous(breaks=seq(0,1,0.1),labels=paste0(seq(0,100,10),"%"))+
	themep+
	theme(panel.grid.minor.x=element_blank(),
	panel.grid.minor.y=element_blank())
	##2-8
	trd %>% group_by(season,shot_type) %>% summarise(shot_type_n=n()) %>% group_by(season) %>%
	mutate(season_shot_n=sum(shot_type_n),
	p=shot_type_n/season_shot_n,
	loc=cumsum(shot_type_n)-0.5*shot_type_n) %>% ungroup %>%
	ggplot(aes(x=season,y=shot_type_n,fill=shot_type))+
	geom_bar(stat="identity")+
	geom_text(aes(x=season,y=loc,label=paste0(shot_type_n,"(",round(p,3)*100,"%)")),size=3,fontface="bold")+
	geom_text(aes(x=season,y=season_shot_n,label=season_shot_n),vjust=-1,color="blue",fontface="bold")+
	ggtitle("(2-8-1) The number and proportion of shot_type by each_season")+
	ylab("Number of shot_type")+
	themep
	trd %>% group_by(season,shot_type,shot_made_flag) %>% tally %>% group_by(season,shot_type) %>% mutate(p=ifelse(shot_made_flag==1,paste0(round(n/sum(n),3)*100,"%"),"")) %>%
	ungroup %>% arrange(season,shot_type,desc(shot_made_flag)) %>% group_by(season,shot_type) %>% mutate(loc=cumsum(n)-0.5*n,sumn=sum(n)) %>% ungroup %>%
	ggplot(aes(x=season,y=n,fill=factor(shot_made_flag)))+
	geom_bar(stat="identity",position="stack")+
	geom_text(aes(x=season,y=loc,label=p),fontface="bold",size=4,color="red")+
	geom_text(aes(x=season,y=sumn,label=sumn),vjust=-1,fontface="bold")+
	scale_fill_manual(name="shot_made_flag",breaks=c("0","1"),labels=c("Failed","Made"),values=RColorBrewer::brewer.pal(3,"Accent")[2:1])+
	facet_grid(~shot_type)+
	ggtitle("(2-8-2) The Field Goal (%) of shot_type by each season")+
	ylab("Number of shot_type")+
	themep+
	theme(
	strip.text.x=element_text(size=14,face="bold"),
	axis.text.x=element_text(angle=90,vjust=0.3)
	)

view raw gistfile1.txt hosted with ❤ by GitHub