THỰC HÀNH GIẢI THUẬT PHÂN CỤM (GOM CỤM, CLUSTERING)
Dữ liệu sử dụng: U.S Airline
1. Sử dụng Exploratory
- Đăng kí tài khoản và tải về Exploratory
- Cài đặt biến môi trường EXPLORATORY_HOME=C:\exploratory
- Cài đặt tự động R 3.5.1 và git 2.8
- Dữ liệu sử dụng: 2008.csv, 673MB
- Mô tả tập dữ liệu:
1. DayofMonth December 1st to December 31th.
2. DayOfWeek 1 refers to Monday and in a similar way, 7 refers to Sunday.
3. DepTime Actual departure time
4. ArrTime Actual arrival time
5. CRSDepTime Scheduled departure time
6. CRSArrTime Actual arrival time
7. UniqueCarrier Unique carrier code
8. FlightNum Flight number
9. ActualElapsedTime In minutes
10. CRSElapsedTime In minutes
11. AirTime In minutes
12. ArrDelay Arrival delay, in minutes
13. DepDelay Departure delay, in minutes
14. Origin Origin IATA airport code
15. Dest Destination IATA airport code
16. Distance In miles
- Nguồn dữ liệu: />
2. Sử dụng R: Thuật toán k-means
a) Tiền xử lý dữ liệu
//Cài đặt gói dữ liệu cần thiết:
install.packages("dplyr")
install.packages("factoextra")
install.packages("animation")

install.packages("proxy")
install.packages("pamr")
install.packages("clValid")
//Tải các gói vào thư viện
*Lưu ý cài đặt gói còn thiếu
library(cluster) # cluster library
library(proxy) # hcluster function
library(fpc) # cluster.stats function
library(pamr) # pam function
library(clValid) # clValid function
library(ggplot2) # plot diagram
library(dplyr)
library(animation)
library(factoextra)


//Đọc dữ liệu
df=read.csv("2008.csv")
glimpse(df) (Observations: 7,009,728; Variables: 29)
//Trích xuất dữ liệu tháng 12, đủ để phân tích trên máy cấu hình yếu
df=subset(df, Month == "12")
glimpse(df) (Observations: 544,958; Variables: 29)
summary(df)
//Loại bỏ giá trị missing
df = na.omit(df)
glimpse(df) (Observations: 168,647; Variables: 29)
//Loại bỏ một số cột không có ý nghĩa trong phân tích:
df = df[, -20:-29]
Loại bỏ tháng, năm do chúng ta đã chỉ rõ xét dữ liệu tháng 12, còn lại 17 cột
df = df[, -1]

df = df[, -1]
str(df)
Kết quả: Dataset chứa 168,647 bản ghi với 17 biến quan sát
'data.frame':

168647 obs. of

17 variables:

$ DayofMonth

: int

3 3 3 3 3 3 3 3 3 3 ...

$ DayOfWeek

: int

3 3 3 3 3 3 3 3 3 3 ...

$ DepTime

: int

1126 1859 1256 1925 2002 1716 1620 1807 1930 1004 ...

$ CRSDepTime

: int


1045 1825 1240 1900 1940 1610 1555 1725 1905 1005 ...

$ ArrTime

: int

1241 1925 1458 2120 2249 2054 1826 1910 2041 1130 ...

$ CRSArrTime

: int

1200 1900 1435 2100 2230 1950 1800 1845 2020 1115 ...

$ UniqueCarrier

: Factor w/ 20 levels "9E","AA","AQ",..: 18 18 18 18 18 18 18 18 18

18 ...
$ FlightNum

: int

2717 1712 294 2776 623 586 1259 548 619 1152 ...

$ TailNum

: Factor w/ 5374 levels "","80009E","80019E",..: 3796 2127 3943


3316 1395 3593 3475 1430 2524 1177 ...
$ ActualElapsedTime: int

75 86 62 55 107 158 186 63 71 86 ...

$ CRSElapsedTime

: int

75 95 55 60 110 160 185 80 75 70 ...

$ AirTime

: int

55 73 45 46 93 140 177 50 56 51 ...

$ ArrDelay

: int

41 25 23 20 19 64 26 25 21 15 ...

$ DepDelay

: int

41 34 16 25 22 66 25 42 25 -1 ...

$ Origin


: Factor w/ 303 levels "ABE","ABI","ABQ",..: 3 3 3 3 3 3 3 3 3 3

...
$ Dest

: Factor w/ 304 levels "ABE","ABI","ABQ",..: 82 157 160 175 177 181

219 223 223 291 ...
$ Distance

: int

349 487 289 332 718 1121 1111 328 328 321 ...

b) Mô tả các biến
1. DayofMonth December 1st to December 31th.
summary(df$DayofMonth)
Min. 1st Qu.
1.00

11.00

Median
18.00

Mean 3rd Qu.
17.18

23.00


Max.
31.00

2. DayOfWeek 1 refers to Monday and in a similar way, 7 refers to Sunday.
summary(df$DayOfWeek)


Min. 1st Qu.
1.000

2.000

Median
4.000

Mean 3rd Qu.
3.741

Max.

5.000

7.000

Mean 3rd Qu.

Max.

1466


1841

2400

Mean 3rd Qu.

Max.

1563

2400

3. DepTime Actual departure time
summary(df$DepTime)
Min. 1st Qu.
1

Median

1117

1510

4. ArrTime Actual arrival time
summary(df$ArrTime)
Min. 1st Qu.
1

1230


Median
1642

2014

5. CRSDepTime Scheduled departure time
summary(df$CRSDepTime)
Min. 1st Qu.
5

1040

Median
1425

Mean 3rd Qu.

Max.

1400

1749

2359

Mean 3rd Qu.

Max.


1581

2359

6. CRSArrTime Actual arrival time
summary(df$CRSArrTime)
Min. 1st Qu.
1

1230

Median
1624

1950

7. UniqueCarrier Unique carrier code
carrier = data.frame(df$UniqueCarrier)
qplot(x = df$UniqueCarrier, data = carrier, fill = df$UniqueCarrier)

Hãng hàng không Southwest chiếm phần lớn thị phần các chuyến bay ở Hoa Kỳ trong năm
2008. Số lượng chuyến bay của họ thậm chí còn lớn hơn tổng số chuyến bày của Hãng hàng
không Skywest và Hãng hàng không Hoa Kỳ. Chúng tôi cũng sẽ giúp bạn tìm ra hãng hàng
không nào là lựa chọn hàng đầu nếu bạn muốn tránh delay.
8. FlightNum Flight number
summary(df$FlightNum)
Min. 1st Qu.
1

658


Median
1676

Mean 3rd Qu.

Max.

2357

9741

3593


9. ActualElapsedTime In minutes
summary(df$ActualElapsedTime)
Min. 1st Qu.
18.0

Median

88.0

126.0

Mean 3rd Qu.
143.5

Max.


177.0

790.0

Mean 3rd Qu.

Max.

10. CRSElapsedTime In minutes
summary(df$CRSElapsedTime)
Min. 1st Qu.
26.0

Median

82.0

116.0

134.5

165.0

660.0

Mean 3rd Qu.

Max.


11. AirTime In minutes
summary(df$AirTime)
Min. 1st Qu.
6

Median

60

93

112

141

647

12. ArrDelay Arrival delay, in minutes
summary(df$ArrDelay)
Min. 1st Qu.
15.00

Median

24.00

41.00

Mean 3rd Qu.
62.55


Max.

77.00 1655.00

13. DepDelay Departure delay, in minutes
summary(df$DepDelay)
Min. 1st Qu.
-34.00

Median

15.00

35.00

Mean 3rd Qu.
53.53

Max.

71.00 1597.00

14. Origin Origin IATA airport code
summary(df$Origin)
ATL

ORD

DEN


DFW

DTW

PHX

EWR

IAH

LAS

MSP

12232

11020

7004

6208

4984

4353

4333

4269


4020

4004

LAX

JFK

SLC

SFO

SEA

CLT

BOS

PHL

MDW

MCO

3837

3409

3375


3370

2992

2977

2841

2676

2546

2481

CVG

BWI

LGA

SAN

DCA

IAD

MEM

MIA


FLL

STL

2457

2383

2272

1832

1768

1714

1665

1601

1590

1504

MKE

TPA

MCI


BNA

CLE

PDX

HOU

RDU

DAL

OAK

1491

1489

1381

1358

1352

1329

1324

1297


1218

1211

HNL

SMF

PIT

SJC

IND

SNA

ABQ

AUS

SAT

MSY

1164

1131

1061


1003

989

944

905

872

809

806

CMH

PBI

BUF

OMA

JAX

BDL

BUR

RSW


BHM

ONT

757

733

727

704

643

629

627

607

546

521

PVD

GRR

SDF


TUL

OKC

RNO

DSM

SJU

RIC

MHT

517

514

504

493

488

485

478

471


452

426

DAY

MSN

GEG

LIT

BOI

ELP

TUS

ANC

ICT

LGB

419

408

404


404

394

394

389

384

371

367

TYS

ALB

ROC

XNA

SYR

OGG

ORF

HPN


COS

CID

358

356

356

344

343

332

322

317

311

292

CHS

FAT

LEX


GSO

MLI

CAE

HSV

SAV

JAN (Other)

287

285

282

278

271

268

260

259

251


12768

Sân bay bận rộn nhất ở Hoa Kỳ là sân bay Atlantic. Chicago và Denver đứng thứ hai và
thứ ba.
15. Dest Destination IATA airport code
summary(df$Dest)
ATL

ORD

DEN

DFW

LAX

PHX

LAS

EWR

SFO

IAH

11791

9506


6338

5159

5013

4663

4357

4335

4277

4271


DTW

MSP

JFK

SLC

SEA

MCO


LGA

PHL

BOS

CLT

3575

3280

3238

3216

3131

3015

2818

2669

2541

2422

SAN


BWI

FLL

MDW

CVG

TPA

MEM

DCA

MIA

IAD

2265

2142

1959

1912

1831

1748


1721

1710

1702

1494

PDX

RDU

MCI

STL

SMF

OAK

BNA

CLE

MKE

SJC

1483


1455

1384

1374

1361

1351

1346

1314

1290

1210

HOU

SNA

SAT

DAL

AUS

ABQ


HNL

PIT

PBI

MSY

1196

1120

1096

1085

1049

1014

981

935

917

889

IND


CMH

RSW

OMA

JAX

BUR

ONT

BUF

TUL

OKC

841

831

758

757

737

717


679

664

615

608

SJU

BHM

TUS

BDL

RNO

ANC

SDF

PVD

DSM

GRR

604


585

585

578

567

560

526

505

501

498

RIC

ELP

BOI

LIT

GEG

MSN


TYS

ICT

DAY

XNA

485

480

472

442

424

415

412

408

406

386

LGB


MHT

COS

ORF

GSO

CHS

ROC

CAE

JAN

HPN

381

373

366

362

336

334


327

301

296

295

SAV

CID

OGG

FAT

ALB

SYR

LEX

HSV

MLI (Other)

293

292


292

291

285

280

276

261

255

13756

Kết quả rất giống với Origin. Chúng ta sẽ cần phải kiểm tra xem sân bay bận rộn nhất có
bị chậm trễ nhất không.
16. Distance In miles
summary(df$Distance)
Min. 1st Qu.
31.0

338.0

Median
599.0

Mean 3rd Qu.
753.3


984.0

Max.
4962.0

Phần lớn nhất của chuyến bay có cự ly dưới 1000 dặm. Mối quan hệ giữa khoảng cách và
thời gian trì hoãn là một câu hỏi khác mà chúng ta cần xác thực.

c) Thực hiện giải thuật K-means
Bởi vì tập dữ liệu gốc quá lớn và rất khó tính toán ma trận khoảng cách. Vì vậy, chúng ta sẽ chỉ
chọn ngẫu nhiên 1000 bản ghi và thực hiện phân tích về mẫu này
cd

=

df[sample(nrow(df),

1000),

] %>%select(-c(UniqueCarrier,

FlightNum,

TailNum,

Origin, Dest))
m = as.matrix(cd)
str(m)
mDist = dist(m)


Tìm tham số k:
Cách 1: Thăm dò k
hvalid <- clValid(m, 2:10, clMethods = c("hierarchical"), validation = "internal",
maxitems = 1e+06)
pamvalid <- clValid(m, 2:10, clMethods = c("pam"), validation = "internal",
maxitems = 1e+06)
kvalid <- clValid(m, 2:10, clMethods = c("kmeans"), validation = "internal",
maxitems = 1e+06)
summary(kvalid)


summary(pamvalid)

summary(hvalid)

Kết quả test cho thấy nên sử dụng k=2 để phân cụm


Cách 2:
//Thăm dò K
fviz_nbclust(m, kmeans, method = "wss")+theme_bw()+geom_vline(xintercept =5, linetype =
2)

newcd = scale(cd)
summary(newcd)
//Quan sát mô hình huấn luyện trên tập dữ liệu
set.seed(12345)
kmeans.ani(newcd, 2)



Tiến hành Phân tích cụm: Với Pam và K-means:
//Giải thuật PAM (k-medoids)
pamC = pam(x = m, 2)

pamcluster = data.frame(pamC$clustering)
total=cbind(cd,pamcluster)
d1=subset(total,pamcluster==1)
d2=subset(total,pamcluster==2)
summary(d1)
summary(d2)


Kết quả cho thấy là các chuyến bay vào Buổi sáng sáng sớm hoặc ban đêm có độ trễ ít hơn.
fviz_cluster(pamC,data=newcd,ellipse.type = "t",ggtheme = theme_classic())


//Giải thuật k-means
kmeans.results = kmeans(m, 2)
clusterdf = data.frame(kmeans.results$cluster)
total = cbind(cd, clusterdf)
k1 = subset(total, kmeans.results.cluster == 1)
k2 = subset(total, kmeans.results.cluster == 2)
totaldf = data.frame(total)
totaldf$kmeans.results.cluster = as.factor(totaldf$kmeans.results.cluster)
qplot(data = totaldf2, x = totaldf2$kmeans.new.cluster, y = totaldf$DepTime, colour =
totaldf2$kmeans.new.cluster, geom = "boxplot")


Kết quả phân cụm có thể được biểu diễn trực quan như sau:

fviz_cluster(kmeans.results,data=cd,ellipse.type = "t",ggtheme = theme_classic())



Kết quả này cho thấy:
1. Các chuyến bay vào buổi sáng và đêm muộn có xu hướng ít trễ chuyến hơn.
2.