Feature Engineering, Ta-Feng

變數製作與資料分割流程

Fig-1: Feature Engineering

Fig-2: Feature Engr. & Data Spliting Process

---

Loading & Preparing Data

Sys.setlocale("LC_ALL","C")

[1] "C"

library(dplyr)
library(ggplot2)
library(caTools)
library(Matrix)
library(slam)
library(rpart)
library(rpart.plot)

rm(list=ls(all=TRUE))
load("data/tf2.rdata")
A2 = subset(A, buy)
c(sum(spl), sum(spl2))

[1] 20008  9269

---

Weekday Percentage: W1 ~ W7

X = X %>% mutate(wday = format(date, "%w"))
table(X$wday)

    0     1     2     3     4     5     6 
18011 12615 11288  9898 11245 10651 14587 

mx = xtabs(~ cust + wday, X)
dim(mx)

[1] 28584     7

mx[1:5,]

      wday
cust   0 1 2 3 4 5 6
  1069 1 1 0 0 0 0 0
  1113 2 1 0 0 0 0 1
  1359 0 1 0 0 0 0 0
  1823 0 1 0 1 1 0 0
  2189 0 0 0 1 0 0 1

mx = mx / rowSums(mx)
mx[1:5,]

      wday
cust         0       1       2       3       4       5       6
  1069 0.50000 0.50000 0.00000 0.00000 0.00000 0.00000 0.00000
  1113 0.50000 0.25000 0.00000 0.00000 0.00000 0.00000 0.25000
  1359 0.00000 1.00000 0.00000 0.00000 0.00000 0.00000 0.00000
  1823 0.00000 0.33333 0.00000 0.33333 0.33333 0.00000 0.00000
  2189 0.00000 0.00000 0.00000 0.50000 0.00000 0.00000 0.50000

A = data.frame(as.integer(rownames(mx)), as.matrix.data.frame(mx)) %>% 
  setNames(c("cust","W1","W2","W3","W4","W5","W6","W7")) %>% 
  right_join(A, by='cust')
head(A)

  cust  W1      W2  W3      W4      W5  W6   W7  r  s f      m   rev  raw age area amount   buy
1 1069 0.5 0.50000 0.0 0.00000 0.00000 0.0 0.00 11 80 2  579.0  1158  129   K    E    786  TRUE
2 1113 0.5 0.25000 0.0 0.00000 0.00000 0.0 0.25 26 81 4  557.5  2230  241   K    F     NA FALSE
3 1359 0.0 1.00000 0.0 0.00000 0.00000 0.0 0.00 59 59 1  364.0   364  104   K    G     NA FALSE
4 1823 0.0 0.33333 0.0 0.33333 0.33333 0.0 0.00  8 91 3  869.0  2607  498   K    D     NA FALSE
5 2189 0.0 0.00000 0.0 0.50000 0.00000 0.0 0.50 29 61 2 7028.0 14056 3299   K    B     NA FALSE
6 3667 0.0 0.00000 0.5 0.00000 0.00000 0.5 0.00 37 55 2 2379.5  4759  351   K    G   1570  TRUE

---

Classification (Buy) Model

TR = subset(A, spl)
TS = subset(A, !spl)

library(rpart)
library(rpart.plot)
rpart1 = rpart(buy ~ ., TR[,c(2:16,18)], method="class")
pred =  predict(rpart1, TS)[,2]  # predict prob
cm = table(actual = TS$buy, predict = pred > 0.5); cm

       predict
actual  FALSE TRUE
  FALSE  3730  873
  TRUE   1643 2330

acc.ts = cm %>% {sum(diag(.))/sum(.)}; acc.ts   # 0.70662          

[1] 0.70662

colAUC(pred, TS$buy)                            # 0.6984

                 [,1]
FALSE vs. TRUE 0.6984

rpart.plot(rpart1,cex=0.6)

rpart2 = rpart(buy ~ ., TR[,c(2:16,18)], method="class",cp=0.001)
pred =  predict(rpart2, TS)[,2]  # predict prob
cm = table(actual = TS$buy, predict = pred > 0.5); cm

       predict
actual  FALSE TRUE
  FALSE  3878  725
  TRUE   1812 2161

acc.ts = cm %>% {sum(diag(.))/sum(.)}; acc.ts   # 0.70417          

[1] 0.70417

colAUC(pred, TS$buy)                            # 0.7169         

                 [,1]
FALSE vs. TRUE 0.7169

rpart.plot(rpart2,cex=0.6)

Regression (Amount) Model

A2 = subset(A, buy) %>% mutate_at(c("m","rev","amount"), log10)
TR2 = subset(A2, spl2)
TS2 = subset(A2, !spl2)

rpart3 = rpart(amount ~ ., TR2[,c(2:17)], cp=0.002)
SST = sum((TS2$amount - mean(TR2$amount))^ 2)
SSE = sum((predict(rpart3, TS2) -  TS2$amount)^2)
1 - (SSE/SST)

[1] 0.24606

---