[retail example ] R :: Tree, R, Scoring, cumulative gains chart plotting , AIC oversampling,

tr01 <- read.csv("tb_tr01.csv")

sku01 <- read.csv("sku_mast01.csv")

tr01$d_date <- as.Date(as.POSIXct(tr01$d_date, origin='1960-01-01',tz="UTC"))

tr01$year <- substr(as.character(tr01$d_date),1,4)

#========================

# Propensity Score 계산 example

#----------------

data(mtcars)

mtcars$cylh <-  ifelse(mtcars$cyl>4,"H","L") 

mtcars$cylh <- as.factor(mtcars$cylh )

t1 <- ctree(mtcars$cylh ~ mtcars$mpg)

pr1 <- predict(t1, newdata=mtcars, type="prob")

class(pr1)

# list

dfpr1 <- data.frame(matrix(unlist(pr1)), nrow=nrow(mtcars) )

mtcars$prpn <- dfpr1[seq(1, nrow(dfpr1), 2),1]

#---[ plotting cumulative gains chart  ]------

# version 1

plot(cumsum(sort(mtcars$prpn/sum(mtcars$prpn), decreasing=TRUE)), type="b")

# version 2

mtcars$pr2 <- predict(t1, newdata=mtcars)

mtcars$pr2cnt <- ifelse(mtcars$cylh=="H", 1,0)

plot(cumsum(mtcars[order(- mtcars$prpn), ]$pr2cnt/sum(mtcars$pr2cnt) *100), type="b")

#----------------------------

tr01 <- read.csv("tb_tr01.csv")

sku01 <- read.csv("sku_mast01.csv")

tr01$d_date <- as.Date(as.POSIXct(tr01$d_date, origin='1960-01-01',tz="UTC"))

tr01$dmonth <- substr(as.character(tr01$d_date),6,7)

d02 <- sqldf('select b.sk_department_id,

b.department_name,

count(distinct a.customer_id) as ncust

from tr01 as a left join sku01 as b

on a.sk_item_id=b.sk_item_id

where a.dmonth="01" and a.year="2003"

group by b.sk_department_id

')

# 2002년 데이터를 사용하여 2003년 1월에 camping gear를 살 확률은?

# .... 살가능성이 높은 고객은?

d03 <- sqldf('select distinct customer_id

from tr01

where year="2002" ' )

sku01$sk_department_id <- as.character(sku01$sk_department_id)

# 타겟변수값 생성

d04 <- sqldf('select distinct a.customer_id,

sum(t_item_amt_sale) as amt_cg0301,

"Y" as is_cg0301

from tr01 as a left join sku01 as b

on a.sk_item_id=b.sk_item_id

where a.dmonth="01" and a.year="2003" 

and b.sk_department_id="7" 

group by a.customer_id ')

d05 <- sqldf('select distinct a.*,

b.is_cg0301,

b.amt_cg0301

from d03 as a left join d04 as b

on a.customer_id=b.customer_id ')

# 2002년에 캠핑기어를 얼마 샀는가?

d06 <- sqldf('select distinct a.customer_id,

sum(t_item_amt_sale) as amt_cg

from tr01 as a left join sku01 as b

on a.sk_item_id=b.sk_item_id

where a.year="2002" 

and b.sk_department_id="7" 

group by a.customer_id ')

# 2002년 금액이 큰 department 확인 -- 탐색

d07 <- sqldf('select b.sk_department_id,

b.department_name,

sum(t_item_amt_sale) as amt_dept

from tr01 as a left join sku01 as b

on a.sk_item_id=b.sk_item_id

where a.year="2002"

group by b.sk_department_id

')

d08 <- sqldf('select distinct a.customer_id,

sum(t_item_amt_sale) as amt_sleepb

from tr01 as a left join sku01 as b

on a.sk_item_id=b.sk_item_id

where a.year="2002" 

and b.sk_department_id="6" 

group by a.customer_id ')

d09 <- sqldf('select distinct a.customer_id,

sum(t_item_amt_sale) as amt_fieldg

from tr01 as a left join sku01 as b

on a.sk_item_id=b.sk_item_id

where a.year="2002" 

and b.sk_department_id="34" 

group by a.customer_id ')

d10 <- sqldf('select distinct a.customer_id,

sum(t_item_amt_sale) as amt_carr

from tr01 as a left join sku01 as b

on a.sk_item_id=b.sk_item_id

where a.year="2002" 

and b.sk_department_id="12" 

group by a.customer_id ')

d11 <- sqldf('select a.*, b.amt_cg ,

c.amt_sleepb, d.amt_fieldg, e.amt_carr

from d05 as a

 left join  d06 as b on a.customer_id=b.customer_id

 left join  d08 as c on a.customer_id=c.customer_id

 left join  d09 as d on a.customer_id=d.customer_id

 left join  d10 as e on a.customer_id=e.customer_id ')

d11[3:7][is.na(d11[3:7])] <- 0

d11[2][is.na(d11[2])] <- "N"

d11$is_cg0301 <- as.factor(d11$is_cg0301)

ct1 <- ctree( is_cg0301~ amt_cg + amt_sleepb + amt_fieldg +amt_carr , data=d11)

d12 <- sqldf('select customer_id,

count(distinct d_date) as ndays,

sum(t_item_amt_sale) as amt_sum

from tr01 

where year="2002" 

group by customer_id

')

d13 <- sqldf('select a.*, b.ndays,

b.amt_sum

from d11 as a

 left join  d12 as b 

 on a.customer_id=b.customer_id  ')

d13[8:9][is.na(d13[8:9])] <- 0

d13$rndseq <- rnorm(nrow(d13),0,1)

quantile(d13$rndseq, c(0.2))

plot(sort(d13$rndseq))

pcutoff <- -0.8369123

d13train <- d13[d13$rndseq> pcutoff , ]  # 80%

d13test <- d13[d13$rndseq <= pcutoff , ] # 20%

ct2 <- ctree( is_cg0301~ amt_cg + amt_sleepb + amt_fieldg +amt_carr + ndays+ amt_sum, data=d13train, control=ctree_control(minsplit = 100, maxdepth = 5, minbucket = 30) )

plot(ct2)

cfm1 <- table( predict(ct2, newdata=d13test ), d13test$is_cg0301 )

cfm1

d13test$predictedis_cg0301 <- predict(ct2, newdata=d13test )

plot(d13test$predictedis_cg0301, d13test$is_cg0301 )

accuracyct1 <- (cfm1[1,1] + cfm1[2,2] ) / nrow(d13test) *100

#----------- OVERSAMPLING -----------

d13trainY <-d13train[d13train$is_cg0301=="Y", ]

d13trainN <-d13train[d13train$is_cg0301=="N", ]

nrow(d13trainY) ;  nrow(d13trainN)

quantile(d13trainN$rndseq, c(0.1))

pcutoff <- -0.580916 

d13trainN1 <- d13trainN[d13trainN$rndseq <= pcutoff , ] # 10%

d13train2 <- rbind(d13trainN1, d13trainY)

ct3 <- ctree( is_cg0301~ amt_cg + amt_sleepb + amt_fieldg +amt_carr + ndays+ amt_sum, data=d13train2, control=ctree_control(minsplit = 50, maxdepth = 5, minbucket = 10) )

plot(ct3)

cfm1 <- table( predict(ct3, newdata=d13test ), d13test$is_cg0301 )

cfm1

d13test$predictedis_cg0301 <- predict(ct3, newdata=d13test )

plot(d13test$predictedis_cg0301, d13test$is_cg0301 )

accuracyct1 <- (cfm1[1,1] + cfm1[2,2] ) / nrow(d13test) *100

#----------

pr1 <- predict(ct3, newdata=d13test, type="prob")

class(pr1)

# list

dfpr1 <- data.frame(matrix(unlist(pr1)), nrow=nrow(d13test) )

d13test$prpn <- dfpr1[seq(2, nrow(dfpr1), 2),1]

#---[ plotting cumulative gains chart  ]------

# version 1

plot(cumsum(sort(d13test$prpn/sum(d13test$prpn), decreasing=TRUE)), type="b")

# version 2

d13test$pr2 <- predict(t1, newdata=d13test)

d13test$pr2cnt <- ifelse(d13test$is_cg0301=="Y", 1,0)

plot(cumsum(d13test[order(- d13test$prpn), ]$pr2cnt/sum(d13test$pr2cnt) *100), type="b")

#-----------------------

# 2002년 데이터를 사용하여 2003년 1월에 camping gear를 살 확률은?

# .... 살가능성이 높은 고객은?

=======> 어떤 변수를 추가해야 할 것인가?

Y :: 2003년 1월에 camping gear (department) 구매여부

---------------------

X ::

[] 2002년 1월 캠핑기어 구매 건수 -- 전년 동월

[] 캠핑기어를 한번도 구매하지 않은 고객? --> 캠핑기어 구매 여부 (~2002년 12월)

[] 1월 구매건수, 1월 구매금액 -- 상품군 무관

[] 겨울시즌 구매 건수 -- (겨울은 12~2월), 겨울시즌 구매 금액

[] 캠핑기어의 class 들을 각각 나눠서 금액, 건수로

[] 캠핑기어의 subclass 들 중에서 큰 것 두세개를 각각 나눠서 금액, 건수로

[] 온/오프 채널선호 --- = 오프라인과  온라인 각각 구매횟수 / 전체 구매횟수

[] 전체구매액중 캠핑기어 구매액 비중  --- 비율을 계산해서 적극적 반영

   (구매건수, 구매일수 중 도 추가 )

[] 연관상품의 구매 ?? ---- 캠핑기어와의 연관도를 dept, class 기준으로 계산

  (규모가 크면서 연관도가 높은 상품군 파악)

  - 캠핑기어 살때 동시에 산 물건 -- 같은 날 or 같은 Trx

  - 캠핑기어를 구매한 고객이 구매한 상품군 (12개월 전체 중 시점 무관)

  - 캠핑기어 구매한 고객의 구매비율이 캠핑기어 구매하지 않은 고객의 구매비율 보다

     높은 상품군

[] 최근에 구매가 늘어나고 있는가? --- 3개월구매건수/12개월 구매건수 

[] 구매가 일정한가? --- 월별구매건수의 표준편차 (CV)

#----------------------

# 신용카드 도난 부정사용인 건을 예측하려 한다면?

#---------------

DATA : 가맹점, 시간, 장소, ... 해당회원의 거래내역, 기본정도

Y :: 부정사용건 여부 (1 Vs. 정상건) 

X ::

[] 승인요청금액 --- 직전건 승인실패여부 (연속여부)

[] 장소 --- 최근1년간 사용기록이 있었던 지역(구) 여부, 좁은지역단위, 넓은지역단위 각각  

    --- 도난 빈발장소

[] 가맹점 --- 생전안가던 가맹점 -- 최근1년간 사용이력이 없는 가맹점 

     --- 도난빈발 장소

[] 가맹점 업종 -- 최근1년간 사용이력이 없는 가맹점업종, 큰업종 작은업종 각각 

[] 월별평균사용금액 - 월평균사용금액초과여부  -- 1년중 최대 사용금액 초과여부 

   -- 1년중 최대 사용금액 대비 승인요청금액 비율 

[] 결제시간 --- 생전안긁던 시간대여부, 도난빈발시간대

[] 결제시간간격  -- 단시간(30분이내) 고액 연속사용여부

[] 서명  ---전자서명 동일여부 

q06 <- sqldf('select customer_id, count(*) as cnt

from tr01

where channel_id != "RT"

group by customer_id')

q06 <- sqldf('select customer_id, count(*) as cnt

from tr01

group by customer_id')

#==============

stepAIC {MASS}

stepAIC(object, scope, scale = 0,

        direction = c("both", "backward", "forward"),

        trace= FALSE )

cpus.lm <- lm(log10(perf) ~ ., data = cpus1[cpus.samp,2:8])

cpus.lm2 <- stepAIC(cpus.lm, trace = FALSE)

cpus.lm2$anova

#==============

rf1 <- randomForest( is_cg0301~ amt_cg + amt_sleepb + amt_fieldg +amt_carr + ndays+ amt_sum, data=d13train2, importance=TRUE, do.trace=100, ntree=5000)

plot(rf1, log="y")

varImpPlot(r)

plot(ct3)

cfm1 <- table( predict(rf1, newdata=d13test ), d13test$is_cg0301 )

cfm1

accuracyct1 <- (cfm1[1,1] + cfm1[2,2] ) / nrow(d13test) *100

#--------------

require(MASS)

# stepAIC(object, scope, scale = 0,

#        direction = c("both", "backward", "forward"),

#        trace= FALSE )

lm1 <- lm(ndays ~ amt_cg + amt_sleepb + amt_fieldg +amt_carr +  amt_sum, data=d13train2)

lm1s <- stepAIC(lm1, direction= "backward", trace=TRUE)

#--------------

# 변동계수를 통한 안정성의 변수화 (예제)

# 구매금액이 월별로 일정한가?

# 구매건수가 일정한가?

s1 <- sqldf('select customer_id, dmonth,

sum(t_item_amt_sale) as sum_sale,

count(distinct sk_transaction_id) as cnttr,

count(distinct d_date) as cntday 

from tr01

where year="2003"

group by customer_id, dmonth ')

s1$sum_sale <- as.numeric(s1$sum_sale)

s1$sum_sale <- ifelse(is.na(s1$sum_sale) , 0, s1$sum_sale )

s2 <- sqldf('select customer_id, 

stdev(sum_sale)/avg(sum_sale) as cv_sum_sale,

stdev(sum_sale) as sd_sum_sale

from s1

group by customer_id ')

s1[s1$customer_id==9150,]