Skip to content

Instantly share code, notes, and snippets.

@atajti

atajti/csalasdetektalas.R

Created March 29, 2017 13:48
Show Gist options
  • Save atajti/1b5979e0dfae2a472d357b04bb69db76 to your computer and use it in GitHub Desktop.
Save atajti/1b5979e0dfae2a472d357b04bb69db76 to your computer and use it in GitHub Desktop.
Download ZIP
Csalásdetektálás az Andego-nál | BURN meetup 2017.03.29.
Raw
csalasdetektalas.R
#-------------------------------------------------------------------#
### Csalásdetektálás - gépjárműbiztosítás ###########################
### BURN meetup 2017.03.29 ###########################
#-------------------------------------------------------------------#
# szükséges csomagok:
# data.table
# stringr
# igraph
set.seed(20170329)
library(data.table)
library(stringr)
library(igraph)
library(xlsx)
############
#
# 1. Adatok
#
############
fraud_lista <- 5
resztvevok <- data.table(nev=c("Füredi Tibor",
"Fazekas Nándor",
"Nagy Júlia",
"Szabó Béla",
"Szabó Anna",
"Bíró Barbara",
"Király Balázs",
"Varga Sára",
"Boros Kelemen",
"Bogdán Enikő",
"Balázs Ákos",
"Imre Kinga",
"Hegedűs Nikoletta",
"Miklós Tímea",
"Veres Ferenc",
"Kis Virág",
"Fábián Gréta",
"Gál Melinda",
"Orosz Árpád",
"Virág György",
"Balázs Ákos"),
szul_ido=sample(seq(from=as.Date("1950-01-01"),
to=as.Date("1995-12-30"),
by=1), 21),
anyja=c("Faragó Beatrix",
"Fülöp Flóra",
"Vörös Luca",
"Katona Edit",
"Pásztor Ildikó",
"Horváth Dalma",
"Farkas Alexandra",
"Kozma Renáta",
"Major Petra",
"Váradi Krisztina",
"Juhász Eszter",
"Oláh Bettina",
"Sándor Brigitta",
"Takács Mónika ",
"Budai Laura",
"Dudás Zsanett",
"Pap Dorottya",
"Pataki Fruzsina",
"Soós Ágnes",
"Mezei Edina",
"Juhász Eszter"),
id=1:21,
kar=as.integer(c(1,3,3,1,2,2,3,4,2,1,6,2,7,4,5,7,4,8,8,6,5)),
oldal=c("okozó","károsult","okozó","okozó",
"károsult","károsult","okozó",
"károsult","okozó","károsult",
"okozó","okozó","károsult","okozó",
"károsult","okozó","károsult","károsult",
"okozó","károsult","okozó"),
szerep=c("sofőr","tulaj","sofőr","utas",
"tulaj","sofőr","tulaj","sofőr",
"sofőr","sofőr","utas","sofőr",
"sofőr","sofőr","sofőr","tulaj",
"sofőr","sofőr","sofőr","sofőr","sofőr"),
auto_ertek=c(1.6, NA, 7, NA, NA, 3.2, NA, 5,
3, 10, NA, 2.1, 0.8, 3.2, 5.6, NA,
3.4, 1.6, 1.2, 2.8, 1.8)*10^6,
rendszam=c("abk-235", NA, "CSIGA-9", NA, NA,
"EDM-523", NA,
"EZT-956", "KLM-768", "BPI-652", NA,
"ckl240", "NOK-721", "EDM-523",
"KOM-591", NA, "DOM-612", "JEJ-636",
"FTW-666", "HAZ-415", "B-90210"),
bankszamlaszam=c("11742001-15441276-03610000",
"11742001-15441276-08800000",
"11742001-15441276-02440000",
"11742001-15441276-08970000",
"11742001-15441276-03540000",
"11742001-15441276-04400000",
"11742001-15441276-03470000",
"11742001-15441276-03780000",
"11742001-15441276-02510000",
"12001008-00155660-00100004",
"12001008-00145499-00100001",
"12001008-00155671-00100000",
"12001008-01253222-00100000",
"12001008-01259699-00100000",
"12001008-00301234-00100002",
"12001008-00301201-00100004",
"12001008-00155682-00100006",
"12001008-00100754-00100006",
"12001008-00113696-00100001",
"11742001-15441276-02440000",
"12001008-00155671-00100000"))
ceginformacio <- data.table(ceg_neve=c(rep("Dr. Balogh Ügyvédi Iroda",2),
rep("Berényi KFT.", 4),
rep("Novák Futár", 3)),
nev=c("Berényi Miklós", "Dr. Balogh Nóra",
"Berényi Miklós", "Dr. Balogh Nóra",
"Berényi Klaudia", "Berényi András",
"Novák László", "Varga Sára",
"Veres Ferenc"),
anyja=c("Péter Barbara", "Szűcs Evelin",
"Péter Barbara", "Szűcs Evelin",
"Szőke Zsófia", "Péter Barbara",
"Mészáros Boglárka", "Kozma Renáta",
"Budai Laura"),
id=c(1,2,1,2,3,4,5,6,7))
karadat <- data.table(kar=1:8,
datum=as.Date(c("2010-04-20", "2011-09-11",
"2011-06-19", "2011-08-25",
"2011-12-28", "2011-04-24",
"2011-03-23", "2011-09-28")),
kulterulet=sample(c(0,1), 8, replace=TRUE))
###################
# 1.1 Adattisztítás
###################
resztvevok[, `:=`(nev=stringr::str_trim(toupper(iconv(nev,
from="UTF-8",
to="ASCII//TRANSLIT"))),
anyja=stringr::str_trim(toupper(iconv(anyja,
from="UTF-8",
to="ASCII//TRANSLIT"))),
rendszam=stringr::str_trim(toupper(gsub("[^[:alnum:]]",
"",
rendszam))),
bankszamlaszam=stringr::str_trim(toupper(gsub("[^[:alnum:]]",
"",
bankszamlaszam))))]
ceginformacio[, `:=`(nev=stringr::str_trim(toupper(iconv(nev,
from="UTF-8",
to="ASCII//TRANSLIT"))),
anyja=stringr::str_trim(toupper(iconv(anyja,
from="UTF-8",
to="ASCII//TRANSLIT"))))]
###################
#
# 2. ÜGYFÉLTÖRZS
#
###################
# különböző kéresetek résztvevőinek összefűzése
###########################################
# 2.1 céginformációs adatok összekapcsolása
###########################################
resztvevok <- ceginformacio[, .(nev, anyja, ceginfo_id=id)][
resztvevok,
on=c("nev", "anyja")]
#######################
# 2.2 belső ügyféltörzs
#######################
# két ügyfél u.az, ha a név megegyezik,
# és az anyja neve vagy a születési dátum megegyezik
# az egyes rekordokat gráfként kezelve az ugyanarra az emberre vonatkozó
# rekordok ugyanabban a komponensben lesznek.
merging_attrs <- list(c("nev", "anyja"),
c("nev", "szul_ido"),
c("ceginfo_id"))
resztvevo_alapadatok <- resztvevok[, .(nev, anyja, szul_ido,
ceginfo_id)][, id:=.I]
resztvevo_ellista <- rbindlist(lapply(merging_attrs,
# megadott változókombók alapján létrehozom az éllistát
function(v_list){
merge(resztvevo_alapadatok[eval(parse(text=paste0("!is.na(", v_list, ")", collapse="&")))
,c(v_list, "id"), with=FALSE],
resztvevo_alapadatok[eval(parse(text=paste0("!is.na(", v_list, ")", collapse="&")))
,c(v_list, "id"), with=FALSE],
by=v_list,
all=TRUE,
allow.cartesian=TRUE,
suffixes=c("_1", "_2"))[, (v_list) := NULL]
}))
resztvevo_ellista <- resztvevo_ellista[!(id_1==id_2)]
# gráf létrehozása
#komponensek keresése,
# minden komponens megkapja a legkisebb sorszámot
graf <- graph_from_data_frame(resztvevo_ellista, directed=FALSE)
komponensek <- components(graf)
komponens_info <- data.table(id=V(graf)$name,
komponens=komponensek$membership)
komponens_info[, uj_id := min(id), by=komponens]
# a megfelelő sorokban ki kell cserélni az id-t:
resztvevok[as.integer(komponens_info$id),
id := as.integer(komponens_info$uj_id)]
###########################
### 3. SCORE-OK KISZÁMÍTÁSA
###########################
##########################
# 3.1 adatbányászati score
##########################
# Elemzés és kárszakértőkkel való egyeztetés
# során kialakított figyelmeztető pontszámok
osszes_biztositoi_adat <- karadat[resztvevok, on="kar"]
DM_score <- osszes_biztositoi_adat[,
.(hetvege=as.integer(!(as.POSIXlt(datum[1])$wday) %in% 1:5),
kulterulet=as.integer(kulterulet[1]),
kor=sapply(as.numeric(datum-szul_ido)/365,
function(x){
if(x<35){
2
} else if(x<55){
1
} else {
0
}
}),
ertekkulonbseg=as.integer(auto_ertek*(oldal=="károsult" &
szerep=="sofőr")/
auto_ertek*(oldal=="okozó" &
szerep=="sofőr")>.2)),
by=kar]
###################
# 3.2 saját hálózat
###################
# károk összekötése közös szereplő, bankszámlaszám, rendszám alapján
karinfo_ellista <- rbindlist(list(
osszes_biztositoi_adat[!is.na(id), .(kar_1=kar, id)][
osszes_biztositoi_adat[!is.na(id), .(kar_2=kar, id)],
on="id", allow.cartesian=TRUE][,
`:=`(tipus="resztvevo",
id=NULL)],
osszes_biztositoi_adat[!is.na(bankszamlaszam),
.(kar_1=kar, bankszamlaszam)][
osszes_biztositoi_adat[!is.na(bankszamlaszam),
.(kar_2=kar, bankszamlaszam)],
on="bankszamlaszam", allow.cartesian=TRUE][,
`:=`(tipus="bankszamla",
bankszamlaszam=NULL)],
osszes_biztositoi_adat[!is.na(rendszam),
.(kar_1=kar, rendszam)][
osszes_biztositoi_adat[!is.na(rendszam),
.(kar_2=kar, rendszam)],
on="rendszam", allow.cartesian=TRUE][,
`:=`(tipus="rendszam",
rendszam=NULL)]))
karinfo_ellista <- karinfo_ellista[which(kar_1<kar_2),]
plot(graph_from_data_frame(karinfo_ellista, directed=FALSE))
############################
# 3.3 céginformációs hálózat
############################
# közösen tulajdonolt cégek kapcsolatot jelentenek a felek közöt
ceginfo_ellista <- ceginformacio[id %in% resztvevok$ceginfo_id,
.(id_1=id, ceg_neve)][
ceginformacio[id %in% resztvevok$ceginfo_id,
.(id_2=id, ceg_neve)],
on="ceg_neve"][, `:=`(ceg_neve=NULL,
tipus="ceginfo")]
ceginfo_ellista <- ceginfo_ellista[id_1<id_2]
ceginfo_kar_ellista <- resztvevok[, .(id_1=ceginfo_id, kar_1=kar)][
ceginfo_ellista, on="id_1"]
ceginfo_kar_ellista <- resztvevok[, .(id_2=ceginfo_id, kar_2=kar)][
ceginfo_kar_ellista, on="id_2"][,
.(kar_1, kar_2, tipus)]
##########################
# 3.4 távolság alapú score
##########################
# minél közelebb van a hálózatban egy kár egy csaláshoz,
# annál nagyobb az esélye hogy az is csalás
teljes_kargraf <- graph_from_data_frame(rbindlist(list(karinfo_ellista,
ceginfo_kar_ellista)),
directed=FALSE)
plot(teljes_kargraf)
d_kar <- distances(teljes_kargraf,
v=V(teljes_kargraf)[V(teljes_kargraf)$name %in%
fraud_lista])
tavolsag_score <- data.table(kar=as.integer(dimnames(d_kar)[[2]]),
tavolsag_score=apply(d_kar,
2,
FUN=function(x){
return(1/(min(x, na.rm=TRUE)+1))
}))
##############
#
# 4. EREMÉNYEK
#
##############
#######################
# 4.1 tábla elkészítése
#######################
eredmeny <- merge(DM_score, tavolsag_score)
# excel tábla
wb <- createWorkbook(type="xlsx")
addDataFrame(eredmeny,
createSheet(wb, "eredmeny"),
row.names=FALSE)
# kiemelendő cellák színe
value_cellstyle <- CellStyle(wb)+
Fill(backgroundColor="red",
foregroundColor="red")
# minden nem 0 vagy NA értékű cell színezése
for(sheet_i in seq_along(getSheets(wb))){
sheet <- getSheets(wb)[[sheet_i]]
for(row_i in seq_along(getRows(sheet))){
row <- getRows(sheet, rowIndex=row_i)
for(col in seq(ncol(get(sheet$getSheetName())))){
cell <- getCells(row, colIndex=col)
if(isTRUE(as.logical(getCellValue(cell[[1]])))){
lapply(cell, setCellStyle, value_cellstyle)
}
}
}
}
# excel fájl mentése
saveWorkbook(wb, paste0(Sys.Date(), "_csalas_pontszamok.xlsx"))
###################
# 4.2 e-mail küldés
###################
require(mailR)
send.mail(
from="Tajti András Andego kft. <[email protected]>",
to="[email protected]",
subject=paste0("Feldolgozott káresetek ", Sys.Date()),
body = paste0("Tisztelt Biztosító!\n",
"A friss adatokat csatolva küldjük.\n",
"Köszönjük bizalmát, további szép napot:",
"Andego kft.",
collapse=""),
smtp = list(host.name = "smtp.gmail.com",
port = 465,
user.name="[email protected]",
passwd="nemmondommeg:P",
ssl=TRUE),
authenticate = TRUE,
send = TRUE,
attach.file=paste0(Sys.Date(), "_csalas_pontszamok.xlsx"))
@daroczig
Copy link

daroczig commented Apr 3, 2017

A kapcsolodo meetup: https://www.meetup.com/Budapest-Users-of-R-Network/events/237964368/
Es az eloadasrol keszult felvetel: https://youtu.be/VAevR69wf78

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment