[KDATA VDXF] 금융분석 R
https://cran.r-project.org/web/packages/insuranceData/insuranceData.pdf
R Package ‘insuranceData’
[프로젝트 결과문서PPT 포함할 내용(Example)]
------------
● 프로젝트 범위 - 사용데이터, 주제, 분석방법
(= 무엇까지만 하고자 했는지)
● 분석주제의 특성 (예: 문제의 업무적 중요도, 주요이슈, 일반적인 해결방법, 통상적인 해결 수준, 최근 동향 등)
● 사용데이터의 특성 - 데이터량, 항목, 구조, 품질 등
● 분석 수행과정 요약 - 흐름을 한장의 챠트로
● 분석 수행과정에서의 특이사항 (발견사항, 이슈, 이슈해결 등)
● 분석 결과 중 공유할만한 사항(insight, 시각화, 모델이라면 정확도 등) - 시각적 표현 바람직
● 프로젝트 수행과정에서 배운 점(Lessons learned)
● 부록: 분석수행 과정 및 결과 상세 사항들 (프로젝트 팀 자체의 경험 공유 측면)
Medical Cost Personal Datasets
Insurance Forecast by using Linear Regression
https://www.kaggle.com/mirichoi0218/insurance
https://www.kaggle.com/easonlai/sample-insurance-claim-prediction-dataset
Credit Card Default Prediction dataset ::
# epoch 100 == 83.900%
# epoch 300 == 84.360%
acl_y <- maxmindf[test_index,]$yno
pred_y <- pred$y
dfres <- data.frame(acl_y, pred_y)
dfres1 <- dfres[order(dfres$acl_y),]
plot(100-((1:nrow(dfres1))/nrow(dfres1)*100),jitter(dfres1$acl_y),
ylab='target value - red:predicted', lty=2, col='darkgrey',
xlab='%cnt_customer',
main='Bank Marketing - Keras: Actual Vs. Predicted')
points(100-((1:nrow(dfres1))/nrow(dfres1)*100),jitter(dfres1$pred_y), col='red')
abline(h=0.5, lty=3)
abline(v=80, lty=3)
질문 : 예측이 잘되는 고객과 잘되지 않는 고객의 유형이 존재하는가??
Outlier detection with Isolation Forest using Solitude package in R
https://www.kaggle.com/norealityshows/outlier-detection-with-isolation-forest-in-r
isolation_forest() from solitude
isolation_forest() from solitude could be a faster version
(internally uses ranger. Arguments may be passed to it except these: dependent.variable.name, data, mtry, min.node.size, splitrule, num.random.splits, respect.unordered.factors.
Pass 'seed' argument for reproducibility.)
B2B 온라인리테일 - 거래건 dataset
# UCI online retail data set link ::
# https://archive.ics.uci.edu/ml/datasets/online+retail
Exploratory Data Analysis on E-Commerce Data :
https://towardsdatascience.com/exploratory-data-analysis-on-e-commerce-data-be24c72b32b2
B2B 온라인리테일
* 이상한 (특이패턴) 거래로 의심해볼만한 경우(후보) - 예
- 한 건에 수량이 너무 많음 (평소대비)
- 한 건에 금액이 너무 큼
- 한 건에 수량이 너무 많음 (평소의 해당 상품군 주문수량 대비)
- 거래가 없던 요일에 거래 발생
- 거래가 없던 시간대에 거래 발생
- 거래가 없던 국가에서 거래 발생
- 하루에 너무 여러건 주문이 서로 다른 시간대에 발생
- 한 건의 주문금액이 평소대비 너무 큼(거래가 빈번한 고객에 한정)
- 주문 없던 상품군(카테고리)에서 거래 발생
- 수량은 대폭 늘었으나 단가는 대폭 줄었음. 또는 정반대 경우
anomaly detection 참고용 -- 개념 slide & script (온라인 리테일)
http://blog.daum.net/revisioncrm/430
[B] 이상패턴 탐지 (anomaly detection) .... 부분 참고
# item description을 그루핑하기 위해서 embedding을 활용한다면?
https://cran.r-project.org/web/packages/text2vec/vignettes/glove.html
# error .... (신버전 변경 사항 고려)
http://text2vec.org/glove.html
# 랜덤포리스트가 느려서 걱정이라면? 레인저로 돌려보면?
# .......... [R분석] randomForest와 ranger 속도 차이 비교
http://blog.daum.net/revisioncrm/390
### 모든 description을 MECE 하게 분류하기 곤란하니
# 중요해 보이는 일부만 중복 추출하는 키워드를 사용
# install.packages('text2vec')
library(text2vec)
# online retail 데이터 로딩
oRd01 <- read.csv("https://t1.daumcdn.net/cfile/blog/99CE763F5A61942711?download",
stringsAsFactors = FALSE)
# item description column
dfpdesc <- unique(oRd01[,c("StockCode","Description")])
dfpdesc$DescriptionID <- seq(1, nrow(dfpdesc))
dfpdesc <- dfpdesc[,c("DescriptionID","Description")]
pdesc <- dfpdesc$Description
nrow(dfpdesc)
# Create iterator over tokens
tokens = space_tokenizer(pdesc)
# Create vocabulary. Terms will be unigrams (simple words).
it = itoken(tokens, progressbar = FALSE)
vocab = create_vocabulary(it)
# 1% 정도의 건에는 등장하는 단어만 적용 (건수가 좀 있는 이름들만)
vocab = prune_vocabulary(vocab, term_count_min = 10)
# 뽑혀진 단어빈도 집계에서 빈도가 상당히 높은 것들만 추출
dfvocab <- data.frame(vocab$term, vocab$term_count)
names(dfvocab) <- c('term','term_cnt')
dfvocab[dfvocab$term_cnt>=70,]
# 눈으로 중요 단어 선정
barplot(dfvocab[dfvocab$term %in% c('CHRISTMAS', 'HOLDER', 'CANDLE'),]$term_cnt,
names.arg=c('CHRISTMAS', 'HOLDER', 'CANDLE'))
# 일부 빈도가 매우 높은 중요단어만 선정해서
# overlap 되는 상품집단을 정의
# 예: CHRISTMAS라는 단어가 들어간 모든 상품코드와 이름 추출
dfpdesc[grepl("(?=.*CHRISTMAS*)", dfpdesc$Description, perl = TRUE),]
#-------------------
# install.packages('text2vec')
library(text2vec)
# online retail 데이터 로딩
oRd01 <- read.csv("https://t1.daumcdn.net/cfile/blog/99CE763F5A61942711?download",
stringsAsFactors = FALSE)
# item description column
dfpdesc <- unique(oRd01[,c("StockCode","Description")])
dfpdesc$DescriptionID <- seq(1, nrow(dfpdesc))
dfpdesc <- dfpdesc[,c("DescriptionID","Description")]
pdesc <- dfpdesc$Description
nrow(dfpdesc)
# Create iterator over tokens
tokens = space_tokenizer(pdesc)
# Create vocabulary. Terms will be unigrams (simple words).
it = itoken(tokens, progressbar = FALSE)
vocab = create_vocabulary(it)
# vocab = prune_vocabulary(vocab, term_count_min = 5)
# 1% 정도의 건에는 등장하는 단어만 적용
vocab = prune_vocabulary(vocab, term_count_min = 10)
# Use our filtered vocabulary
vectorizer = vocab_vectorizer(vocab)
# use window of n for context words
tcm = create_tcm(it, vectorizer, skip_grams_window = 3)
glove = GlobalVectors$new(word_vectors_size = 10, vocabulary = vocab,
x_max = 10, learning_rate = 0.01)
wv_main = glove$fit_transform(tcm, n_iter = 500, convergence_tol = 0.005)
dim(wv_main)
wv_context = glove$components
dim(wv_context)
word_vectors = wv_main + t(wv_context)
# 단어간의 거리 구하기 예제 -- 단어 변경해서 적용!
# berlin = word_vectors["paris", , drop = FALSE] -
# word_vectors["france", , drop = FALSE] +
# word_vectors["germany", , drop = FALSE]
# cos_sim = sim2(x = word_vectors, y = berlin, method = "cosine", norm = "l2")
# head(sort(cos_sim[,1], decreasing = TRUE), 5)
# check results
head(word_vectors)
plot(word_vectors[,1], word_vectors[,2])
kmm1 <- kmeans(word_vectors, 5)
plot(table(kmm1$cluster))
plot(word_vectors[,1], word_vectors[,2], col=kmm1$cluster)
# 클러스터링 된 단어들에 단어 라벨 표시
plot(word_vectors[,2], word_vectors[,3], col=kmm1$cluster)
text(word_vectors[,2], word_vectors[,3],
labels=rownames(word_vectors),
pos=2, cex=0.5)
mtrx_tokn <- matrix(unlist(tokens))
# length(mtrx_tokn)
# mtrx_tokn[1:300]
# mtrx_tokn <- mtrx_tokn[nchar(mtrx_tokn)>0]
# length(mtrx_tokn)
# mtrx_tokn[1:300]
dftokens <- data.frame(mtrx_tokn, nrow=length(mtrx_tokn), byrow=T, stringsAsFactors=FALSE)
names(dftokens) <- 'word'
head(dftokens)
dfwv <- as.data.frame(word_vectors)
dfwv$word <- rownames(dfwv)
len_tokens <- length(tokens)
# tokens <- tokens[nchar(tokens)>0]
len_tokens <- length(tokens)
len_tokens
nword_pd <- vector()
for (i in 1:len_tokens) {
# for (i in 1:10) {
tokeni <- unlist(tokens[i])
# print(tokeni)
# print(length(tokeni))
len_tokeni <- length(tokeni)
if (is.na(tokeni[1])) {
print(tokeni)
}
if (len_tokeni>0) {
nword_pd <- c(nword_pd, rep(i, length(tokeni) ))
}
# print((tokens[i][[1]]))
# print(nword_pd)
}
nword_pd[1:100]
length(nword_pd)
dftokens$DescriptionID <- nword_pd
dftokens1 <- merge(dftokens, dfwv, by="word", all.x=T)
head(dftokens1)
# dftokens1 <- dftokens1[!is.na(dftokens1$V1),]
dftokens1 <- dftokens1[,c("DescriptionID", "V1","V2","V3","V4","V5",
"V6","V7","V8","V9","V10")]
dftokens1$V1[is.na(dftokens1$V1)] <- median(dftokens1$V1[!is.na(dftokens1$V1)])
dftokens1$V2[is.na(dftokens1$V2)] <- median(dftokens1$V2[!is.na(dftokens1$V2)])
dftokens1$V3[is.na(dftokens1$V3)] <- median(dftokens1$V3[!is.na(dftokens1$V3)])
dftokens1$V4[is.na(dftokens1$V4)] <- median(dftokens1$V4[!is.na(dftokens1$V4)])
dftokens1$V5[is.na(dftokens1$V5)] <- median(dftokens1$V5[!is.na(dftokens1$V5)])
dftokens1$V6[is.na(dftokens1$V6)] <- median(dftokens1$V6[!is.na(dftokens1$V6)])
dftokens1$V7[is.na(dftokens1$V7)] <- median(dftokens1$V7[!is.na(dftokens1$V7)])
dftokens1$V8[is.na(dftokens1$V8)] <- median(dftokens1$V8[!is.na(dftokens1$V8)])
dftokens1$V9[is.na(dftokens1$V9)] <- median(dftokens1$V9[!is.na(dftokens1$V9)])
dftokens1$V10[is.na(dftokens1$V10)] <- median(dftokens1$V10[!is.na(dftokens1$V10)])
dftokens2 <- aggregate(dftokens1, by=list(dftokens1$DescriptionID),
FUN = mean)
head(dftokens2)
kmm2 <- kmeans(dftokens2[,3:5], 12)
# 클러스터링 된 상품설명들에 상품설명 라벨 표시
pdesc_smpl <- c(pdesc[1:60], rep('',length(pdesc)-60))
plot(dftokens2[,3], dftokens2[,4], col=kmm2$cluster)
text(dftokens2[,3], dftokens2[,4],
labels=pdesc_smpl,
pos=2, cex=0.8)
plot(dftokens2[,4], dftokens2[,5], col=kmm2$cluster)
text(dftokens2[,4], dftokens2[,5],
labels=pdesc_smpl,
pos=2, cex=0.5)
dftokens21 <- dftokens2
dftokens21$color <- kmm2$cluster
dftokens21 <- head(dftokens21,50)
dftokens21 <- merge(dftokens21, dfpdesc, by='DescriptionID', all.x=T)
dftokens21[order(dftokens21$color),c(1,10:14)]
dftokens21[order(dftokens21$DescriptionID),c(1,10:14)]
plot(dftokens21[,4], jitter(dftokens21[,5]), col=dftokens21$color,
pch=19)
text(dftokens21[,4], jitter(dftokens21[,5]),
labels=pdesc[1:30],
pos=2, cex=0.5)
[DAY 2] Candidates to Dig?
♧ segment-wise anomaly detection using isolationforest (AE, raw, scaled)
♧ clustering mixed-type (categorical & continuous) features using randomforest
> [Sample Result] clustering categorical features using randomForest (unsupervised)
# 다섯개의 클러스터가 카테고리형 변수들만으로 생성되었음
# 카테고리 변수들이기 때문에 scatterplot으로 시각화되기 어려운 문제가 존재
# DT를 활용해 클러스터 특성을 파악
[Script]
bnk05 <- read.csv
('https://t1.daumcdn.net/cfile/blog/99E6173359C44CE507?download'
)
cols1 <- c('job', 'marital', 'education', 'default',
'housing', 'loan')
bnkt01 <- bnk05[,cols1]
# clustering using randomforest in unsupervised mode
# used categorical variables only
# install.packages('randomForest')
library('randomForest')
rfc1 <- randomForest(y=NULL, x=bnkt01, ntree=100,
proximity = TRUE, oob.prox = TRUE,
importance=T)
hclust.rfc1 <- hclust(as.dist(1-rfc1$proximity),
method = "ward.D2")
rfc1.cluster <- cutree(hclust.rfc1, k=5)
plot(table(rfc1.cluster, bnk05$job))
bnkt02 <- bnkt01
bnkt02$clst <- rfc1.cluster
# 디시젼트리를 사용한 군집특성 프로파일링 분석
# install.packages('party')
library(party)
clstdt1 <- ctree(clst ~ ., data=bnkt02)
plot(clstdt1)
bnkt03 <- bnk05
bnkt03$clst <- rfc1.cluster
# profiling using continuous variables
plot(jitter(bnkt03$age), jitter(bnkt03$balance),
col=bnkt03$clst, cex=1)
# profiling tgt (= y ) variables
plot(jitter(bnkt03$balance, amount=0.3),
jitter(bnkt03$clst, amount=0.3),
col=rgb(ifelse(bnkt03$y=='yes',1,0), 0,
ifelse(bnkt03$y=='yes',0,1),0.2),
cex=1, pch=19)
# 지엽적으로 marital이 구분에 활용되었음
[DAY 3] Candidates to Dig?
♧ detecting unpredictable cases (error -prone instances)
♧ predicting customers' product portfolio (cluster membership) based on both transactions and other profile variables like demographics
# ------- [retail: anomaly detection] detecting unpredictable cases ----------
# 모델로 예측해보았을때 오차가 생긴다면,
# 패턴이 파악되지 않는 케이스로 추측
# 이런 경우가 의심스러운 경우일 가능성 높다고 보고
# 상식적인 모델링을 anomaly detection으로 응용하는 방식
oRd01 <- read.csv("https://t1.daumcdn.net/cfile/blog/99CE763F5A61942711?download",
stringsAsFactors = FALSE)
ord02 <- oRd01[,c('CustomerID', 'InvoiceDate','Quantity', 'UnitPrice')]
ord02$InvoiceMnth <- substr(ord02$InvoiceDate,1,7)
ord02$Amt <- ord02$Quantity * ord02$UnitPrice
head(ord02)
orda1 <- aggregate(Amt~CustomerID+InvoiceMnth, data=ord02, FUN=sum)
install.packages('reshape2')
library(reshape2)
# long to wide transformation
ordad1 <- dcast(orda1, CustomerID ~ InvoiceMnth, value.var="Amt")
ordad1[is.na(ordad1)] <- 0
head(ordad1)
ordad1$AmtTot <- rowMeans(ordad1[,2:13])*13
names(ordad1) <- gsub("-", "_", names(ordad1))
# add prefix to column names
names(ordad1) <- paste("C", names(ordad1), sep = "_")
# build a prediction model
rfa <- randomForest(C_2011_12 ~ .,
data=ordad1[,!(names(ordad1)%in% c('C_CustomerID','C_AmtTot'))],
ntree=2000,
importance=T, do.trace=100)
varImpPlot(rfa)
plot(jitter(ordad1$C_2011_12),
jitter((predict(rfa,ordad1)-ordad1$C_2011_12)/ordad1$C_2011_12),
xlim=c(100, max(ordad1$C_2011_12)),
ylim=c(-1, 5))
abline(h=0, col='red')
# 예측된 값이 실제보다 크다면 의심스러움
ordad2 <- ordad1
ordad2$as01 <- (predict(rfa,ordad1)-ordad1$C_2011_12)/ordad1$C_2011_12
ordad2[ordad2$as01>0 & ordad2$as01<100,]
plot(jitter(ordad2$C_2011_09), jitter(ordad2$C_2011_11),
col=ifelse(ordad2$as01>0 & ordad2$as01<100, 'red','black'))
M <- ordad1[,!(names(ordad1)%in% c('C_CustomerID','C_AmtTot', 'C_2011_12'))]
# 고객별월별 금액의 표준편차 계산
ordad2$rsd <- apply(M, 1, sd)
# 고객별월별 금액의 평균 계산
ordad2$rmn <- apply(M, 1, mean)
# 고객별월별 금액의 변동계수 계산
ordad2$rcv <- ordad2$rsd/ordad2$rmn
# 평균과 표준편차를 축으로 추측된 anomaly 위치 검토
plot(jitter(ordad2$rmn), jitter(ordad2$rcv),
col=ifelse(ordad2$as01>0 & ordad2$as01<100, 'red','black'),
xlim=c(0,1000), ylim=c(-1,5),
main="where's the suspicious?")
# 금액이 평균적으로 큰 동시에 변동계수는 작았던 경우 중에 오차 발생 가능성이
# 비교적 높은 패턴
plot(jitter(ordad1$C_AmtTot), jitter(predict(rfa,ordad1) - ordad1$C_AmtTot))
#---- directly apply isolation forest algorithm ----
o5 <- ordad1[,!(names(ordad1)%in% c('C_CustomerID','C_AmtTot'))]
View(o5) # tabula 포맷으로 보기
library(solitude)
mo <- isolation_forest(o5, seed=1)
#evaluate anomaly score
as <- predict(mo, o5)
summary(as)
# show anomaly score
plot(density(as))
abline(v=0.7, col='red', lty=2)
# 극소수인 0.7 이상을 anomaly로 간주한다면
#--- cutting off density of anomaly score
dd1 <- data.frame(density(as)$x, density(as)$y)
names(dd1) <- c('X','Y')
head(dd1)
dd1dt <- ctree(Y ~ X, data=dd1,
controls = ctree_control(maxdepth = 3, minbucket=10))
plot(dd1dt)
sort(as, decreasing=T)[1:2]
# check what matters the most
library(party)
o5v <- o5
o5v$outF <- as.factor(ifelse(as>0.7,'Y','N'))
o5v1 <- o5v
ctv1 <- ctree(outF~., data=o5v1,
controls = ctree_control(maxdepth = 3))
plot(ctv1)
# 11월에 금액이 큰 고객은 거의 없었음. 어쩌면 anomaly?
# red points : anomaly
'R 데이터 분석' 카테고리의 다른 글
[데이터분석] 데이터 분석 도구 사용 현황 조사 (0) | 2019.09.05 |
---|---|
[KDATA PLOT EDA retail] 플롯 그리기 (0) | 2019.06.08 |
[kdata 2019 recsys 0030] retail recommender using R[전용준 리비젼 recsys r] (0) | 2019.05.18 |
[AI Summit workshop] rf anomaly 1206 (0) | 2018.11.30 |
GameLog-In 데이터준비 (0) | 2018.10.16 |