perjantai 25. lokakuuta 2019

Anomaly detection R:llä Part 1.

Anomaly detection:lla tarkoitetaan usein koneoppimisen "(Semi) Unsupervised"-menetelmiä, joilla datasta voidaan havaita mahdolliset poikkeamat ts. harvinaiset havainnot. Esimerkiksi, jos henkilö X käyttää poikkeuksellisesti koko luottolimiittinsä kerralla, niin tämä transaktio erottuu muista huomattavasti. Miten pankki havaitsee tällaiset poikkeavat tapaukset? Yksinkertaisessa tapauksessa pankki voi tarkastella henkilön X luottotilitapahtumia ja päättää transaktioille suuruus- ja määrärajat, jotka hälyttävät, kun rajat ylitetään.

Esimerkki 1. Yksi normaalijakautunut muuttuja.

Henkilöllä X on 1000 transaktiota viimeisen vuoden aikana ja pankki haluaa asettaa hälytysrajat, jotta epäilyttävän suuret transaktiot voidaan tarkistaa manuaalisesti. Tehdään transaktioista histogrammi ja nähdään, että transaktiot ovat suunnilleen normaalisti jakautuneet. Normaalijakauma-oletuksen avulla tiedetään, että n. 0.15% tapahtumista asettuu plus kolmen keskihajonnan päähän keskiarvosta. Esimerkissä Cut-off-piste asettuu kohtaan 137 €, eli kaikki tämän ylittävät transaktiot hälyttäisivät.

a <- data.frame(transaktiot=c(rnorm(995, mean=70,sd=20),130,140,150))
a <-  -min(a$transaktiot)+a
#Valitaan cut-off-piste kolmen keskihajonnan päästä keskiarvosta.
cutoff <- mean(a$transaktiot)+3*sd(a$transaktiot)

ggplot(data=a,aes(x=transaktiot))+
  geom_histogram(binwidth=5, fill="blue") +
  labs(title="1000 tilitapahtumaa (Cut-off-piste asetettu kolmen keskihajonnan päähän keskiarvosta)",x="Transaktion suuruus €",y="Määrä")+
  theme(plot.title = element_text(hjust = 0.5))+
  geom_vline(xintercept = cutoff, linetype="dotted", 
             color = "red", size=1.5)+
  geom_segment(aes(x = 118, y = 76, xend = 130, yend = 73),size=1.5,
               arrow = arrow(length = unit(0.5, "cm")))+
   annotate(geom="text", x=113, y=79, label="Cut-off-piste",
             color="red",size=6)




Esimerkki 2. Multivariate Gaussian: Useampi riippumaton normaalijakautunut muuttuja.

Normaalijakauma-oletuksen avulla voitaisiin lisätä mukaan myös muita muuttuja (esim. transaktion kellon aika) ja laskea eri yhdistelmille todennäköisyydet. Tällöin hälytys voitaisiin asettaa esim. samaan kohtaan "0.15%", eli vain tämän todennäköisyyden alittavat tapahtumat hälyttäisivät. Käytännössä laskenta tapahtuu niin, että estimoimme kaikille muuttujille keskiarvot sekä keskihajonnat ja saamme näin jokaiselle muuttujalle estimoitua tiheysfunktion (Probability density function). Tämän jälkeen voimme laskea jokaiselle muuttujan arvolle todennäköisyyden. Otetaan esimerkiksi tilanne, kun meillä on kaksi muuttujaa X1 ja X2 (Huom. teemme oletuksen muuttujien riippumattomuudesta).

X1:n keskiarvo on 5 ja keskihajonta 3.
X2:n keskiarvo on 2 ja keskihajonta 1.

Nyt voimme ratkaista, kuinka todennäköistä on saada näistä jakaumista esim. arvot X1=1 ja X2=4.

pX1 <- dnorm(1,mean=5,sd=3)
pX2 <- dnorm(4,mean=2,sd=1)
pX1*pX2
=0.29%

Näemme, että jos cut-off-pisteemme on 0.15% (0.29%>0.15%), niin kyseessä ei ole poikkeava havainto.

Katsotaan esimerkkiä vielä luomalla kuva, jossa on alkuperäisten datapisteiden lisäksi myös Contour-kuva, joka näyttää kohdat (isoviivat), joissa todennäköisyydet ovat samat. Esimerkiksi keskimmäinen isoviiva näyttää alueen, jossa todennäköisyys on korkein. Näemmekin, että tällä alueella todennäköisyydet ovat 4%:n tienoilla.

#Tehdään kaksi muuttujaa 
X1 <- c(rnorm(20,mean=5,sd=3),11,15,16)
X2 <- c(rnorm(20,mean=2,sd=1),5,3,8)
data <- data.frame(X1,X2)
#Lasketaan todennäköisyydet eri yhdistelmille
data$probability <-  dnorm(data$X1,mean=5,sd=3)*dnorm(data$X2,mean=2,sd=1)*100
#Luokitellaan alle 0.15% arvon saavat outliereiksi
data$class_ <- ifelse(data$probability < 0.15,"Outlier","Normaali")
#interpoloidaan arvoja Contour-kuvaa varten
ipdata <- with(data, interp(x=X1, y=X2, z=probability))

ipdata2 <- expand.grid(x=ipdata$x, y=ipdata$y)

ipdata2$z <- as.vector(ipdata$z)
head(ipdata2)
#https://stackoverflow.com/questions/19065290/r-ggplot-stat-contour-not-able-to-generate-contour-lines
head(ipdata2)
ggplot(data, aes(x=X1, y=X2))+
   stat_contour(data=na.omit(ipdata2), binwidth=1, colour="red", aes(x=x, y=y, z=z))+
   geom_point(aes(color=class_),size=3)+
  geom_text(aes(label=paste(round(probability,2),"%")),hjust=0, vjust=1.5)+
  labs(title="Normaalijakautuneet muuttujat ja Anomaly detection (Cut-off-piste 0.15%)",color="Luokittelu")+
  theme(plot.title = element_text(hjust = 0.5),legend.title=element_text(size=15),legend.text=element_text(size=12))






Esimerkki 3.  Multivariate Gaussian: Useampi keskenään korreloitunut muuttuja.

Mitä jos muuttujat korreloivat keskenään? Yllä oletettiin, että muuttujat ovat toisistaan täysin riippumattomia. Todellisuudessa esim. transaktion suuruus ja kellon aika voivat korreloida (esim. yöajan ostokset eroavat luultavasti iltapäivän ostoksista). Ottamalla korrelaation pystymme mallintamaan dataa generoivaa prosessia paremmin, kun muuttujat korreloivat keskenään.

Luodaan data, jossa muuttujat korreloivat keskenään ja lasketaan eri malleilla todennäköisyydet tapahtumille. Lasketaan todennäköisyydet ensin riippumattomuus-oletuksen mallille.

set.seed(1)
X1 <- c(rnorm(20,mean=5,sd=3),11,15,16)
X2 <- c(rnorm(20,mean=7,sd=1),8,9,10)
cor(X1,X2)

data <- data.frame(X1,X2)



#Lasketaan todennäköisyydet eri yhdistelmille
data$probability <-  dnorm(data$X1,mean=mean(X1),sd=sd(X1))*dnorm(data$X2,mean=mean(X2),sd=sd(X2))*100
#Luokitellaan alle 0.15% arvon saavat outliereiksi
data$class_ <- ifelse(data$probability < 0.15,"Outlier","Normaali")
#interpoloidaan arvoja Contour-kuvaa varten
ipdata <- with(data, interp(x=X1, y=X2, z=probability))

ipdata2 <- expand.grid(x=ipdata$x, y=ipdata$y)

ipdata2$z <- as.vector(ipdata$z)

#Luodaan "Riippumattomuus-oletuksella"-kuva
plot1 <- ggplot(data, aes(x=X1, y=X2))+
  stat_contour(data=na.omit(ipdata2), binwidth=1, colour="red", aes(x=x, y=y, z=z))+
  geom_point(aes(color=class_),size=3)+
  geom_smooth(method="lm",se=F)+
  geom_text(aes(label=paste(round(probability,2),"%")),hjust=0, vjust=1.5)+
  labs(title="Riippumattomuus-oletuksella",color="Luokittelu")+
  theme(legend.position = "none",plot.title = element_text(hjust = 0.5),legend.title=element_text(size=15),legend.text=element_text(size=12))


Lasketaan ennusteet seuraavaksi ottamalla muuttujien välinen korrelaatio huomioon estimoidussa tiheysfunktiossa.

data2 <- data[,1:2]
centered <- as.matrix(data.frame(lapply(data2[,1:2],function(x) x-mean(x))))
sigma2=(var(Xval_centered))


#Lasketaan estimoidusta tiheysfunktiosta todennäköisyydet
library(MASS)
a=(2*pi)^(-ncol(Xval_centered)/2)*det(sigma2)^(-0.5)

b= exp(-0.5 *rowSums((Xval_centered%*%ginv(sigma2))*Xval_centered))
prediction=a*b

data2$probability <- prediction*100
data2$class_ <- ifelse(data2$probability <0.15,"Outlier","Normaali")

ipdataz <- with(data2, interp(x=X1, y=X2, z=probability))

ipdata2z <- expand.grid(x=ipdataz$x, y=ipdataz$y)

ipdata2z$z <- as.vector(ipdataz$z)

#Tehdään kuva
plot2 <- ggplot(data2, aes(x=X1, y=X2))+
  stat_contour(data=na.omit(ipdata2z), binwidth=1, colour="red", aes(x=x, y=y, z=z))+
  geom_point(aes(color=class_),size=3)+
  geom_smooth(method="lm",se=F)+
  geom_text(aes(label=paste(round(probability,2),"%")),hjust=0, vjust=1.5)+
  labs(title="Korrelaatio huomioitu",color="Luokittelu")+
  theme(plot.title = element_text(hjust = 0.5),legend.title=element_text(size=15),legend.text=element_text(size=12))+
geom_segment(aes(x = 14, y = 9.5, xend = 14.7, yend = 9.1),size=1.5,
             arrow = arrow(length = unit(0.5, "cm")))+
 annotate(geom="text", x=12.1, y=9.6, label="Todennäköisyys kasvanut",
                       color="red",size=4)

library(gridExtra)

grid.arrange(plot1, plot2, ncol=2,widths=c(2,2.5))

Alla olevasta kuvasta (vasen) näemme aiemmin esitellyn mallin, jossa oletettiin, että muuttujat ovat toisistaan riippumattomia. Oikealla on samalle datalle sovitetun korrelaation huomioivan tiheysfunktion arvot. Sininen viiva on regressioviiva, joka näyttää muuttujien välisen positiivisen korrelaation (r=0.41). Näemme kuinka oikeassa reunassa oleva piste muuttuukin oulierista normaaliksi korrelaation huomioimisen johdosta. Tämä johtuu siitä, että vaikka piste on kaukana massasta, niin silti se on regressiosuoran suuntainen. Näemme myös, että oikean puoleisessa kuvassa alareunan arvot eivät saa enää niin suuria todennäköisyyksiä. 







Havainnollistetaan kahden mallin eroja vielä simuloimalla kaksi voimakkaasti korreloivaa muuttujaa (r=-0.71). Oikean puoleisessa kuvassa otetaan korrelaatio huomioon ja näemme, miten isoviivat ovat lähes kiinni kiinni havannoissa. Vasemman puolimmaisessa kuvassa korrelaatiota ei oteta huomioon, joten isoviivat muodstavat pyöreän alueen havaintojen keskustan päälle.






Alla vielä kuva oikenpuoleisesta tilanteesta. Näemme, että kun keskustasta lähdetään kasvattamaan X1:stä ja samalla pienentämään X2:sta, niin pysymme pidempään korkeimmalla todennäköisyys-alueella. Tämä johtuu korrelaation huomioimisesta. Jos emme huomioi korrelaatiota, niin vastaavassa tilanteessa todennäköisyys laskee jyrkemmin.








Kumpi malleista on parempi?

Vaikka korrelaation huomioiva malli voi kuvastaa paremmin dataa generoivaa prosessia, niin oleellista on miettiä, mikä "outlier" on tilanteessa. On siis tärkeää, että pystymme mittaamaan mallien toimivuutta käytännössä, jotta emme jää vain teoreettiselle pohjalle. Käytännössä voimme määritellä outlierit, kuten tunnetut luottotilin petostapahtumat ja laskea todennäköisyydet näille tapahtumille. Voimme esim. tehdä mallinnuksen täysin puhtaalla datalla, jossa ei ole outliereita ja sen jälkeen sovittaa mallin dataan, jossa on seassa outliereita. Tästä datasetistä voimme tarkastella performanssia ja valita sopivan cut-off-pisteen, jolla outlierit saada tehokkaimmin kiinni. Lopuksi voimme kokeilla mallia täysin uuteen dataan ja katsoa, miten se performoi. Tärkeää cut-off-pistettä on käyttää Precision-Recall-metriikoita, jotta huomioimme myös kustannukset, jotka syntyvät väärin outliereiksi luokitelluista tapahtumista. 

Tässä esitellyt anomaly detection -mallit soveltuvat datalle, jotka ovat normaalijakautuneet. Vaikka alkuperäinen data ei olisikaan normaalijakautunut, niin transformaatiot voivat auttaa (esim. log). Jos data ei ole normaalijakautunutta, niin kannattaa kokeille tekniikoita, joissa normaalijakauma-oletusta ei ole mukana. Kirjoittelen näistä tekniikoista jatkossa lisää. 


tiistai 15. lokakuuta 2019

Shiny - Rstudio: Kohderyhmätyökalu

Mikäli analyytikolle sataa usein rutiininomaisia pieniä kohderyhmäpyyntöjä, kannattaa pyrkiä ratkaisuun. Pienistä puroista kasvaa helposti suuria ja analyytikkoja kuormittavia työtaakkoja.

Ajatellaan esim. tilannetta, jossa osasto X pyytää usein listoja, koska listalle kuuluvat yritykset vaihtuvat tiuhaan tahtiin. Analyytikolle tämä tarkoittaa SQL-kyselyn muokkaamista, ajamista sekä valmiin tiedoston lähettämistä. Aikaa tähän kaikkeen ei välttämättä mene kuin 15-30min, mutta yllättävä aikasyöppö voi olla epätäydellinen informaatio. Ymmärsikö analyytikko tarpeet oikein? Vai unohtiko listan pyytäjä sanoa jotain ja täten lista pitää tehdä uusiksi? Tällaisen pienen työn tekeminen voi lopulta viedä paljon enemmän aikaa, ja kun tätä tapahtuu usein, niin kuukaudessa puhutaan jo huomattavista ajallisista kustannuksista.

Mikä avuksi?

1. Sovitaan tietyt listat automatisoitaviksi esim. kuukausittain. Tällöin aikaa säästyy, mutta toisaalta lista pysyy samana, eli siihen ei pysty tekemään muokkauksia ilman analyytikon välikättä.

2. Parannetaan informaation kulkua, jotta ei tule väärinkäsityksiä. Keskustellaan steikkareiden kanssa rohkeasti, jotta jatkossa listan pyytäjä näkee vain valittavat pizzatäytteet, eli tehdään valinnasta helppoa.

3. Mietitään voisiko listan toteuttaa niin, että listan pyytäjä voisi tehdä muokkaukset ja listan haut itse. Tässä kohtaa RStudion Shiny voi olla suureksi avuksi.

Mikä on Shiny?

Shiny on R-paketti, jolla voi tehdä interaktiivisia web-applikaatioita suoraan R:n kautta. Käytännössä loppukäyttäjä näkee nettisivun, jossa hän voi valita esim. tietyn tuotteen myynnit haluamilleen vuosille. Shiny mahdollistaa siis samoja asioita kuin PowerBi ja Qlik Sense, eli helpottaa tiedon hakua. Shinyn etu edellä mainittuihin työkaluihin on, että sillä voi tehdä kaikkea mitä ärrässäkin voi, eli se mahdollistaa mm. tehokkaammat visualisoinnit.

Shiny apuna listojen teossa

Shinylla pystyy tekemään näkymän, jossa loppukäyttäjä voi valita esim. kaikki asiakkaat, jotka ovat ostaneet tuotetta X. SQL-muodossa tämä tarkoittaa, että loppukäyttäjä pystyy valitsemaan tuotteet, jotka analyytikko muuten syöttäisi manuaalisesti "Where"-lausekkeeseen. Shinylla loppukäyttäjä pystyy siis syöttämään haluamansa kriteerit SQL-lausekkeeseen selkeän käyttöliittymän avulla.

Alla näkymä tekemästäni esimerkkiäpistä. Käyttäjän kaikki valinnat ovat yhteydessä SQL-kyselyyn. Alla olevalla työkalulla käyttäjä pystyy valitsemaan yrityslistan (esim. kohderyhmät) toimialan ja toteutuneiden myyntien perusteella. Lopuksi käyttäjä voi lähettää valmiin listan excelinä.



Miten tällainen työkalu tehdään?

Luodaan ensin tietokanta MySQL:ssä.


create database datamyynnit;
use datamyynnit;
create table asiakkuudet (asiakasID int(10) unsigned auto_increment primary key not null, 
                          Kaupunki varchar(30) not null, Puhelinnumero varchar(20) not null, Toimiala varchar(10) not null);

create table myynnit(asiakasID int(10) not NULL, tilausnumero int(10) unsigned primary key not null, 
                      maara int(10) not null, tuote varchar(30) not null,hinta int(10) not null, pvm date not null);


insert into asiakkuudet (Kaupunki,Puhelinnumero,Toimiala)  values("Espoo","034343434","A");
insert into asiakkuudet (Kaupunki,Puhelinnumero,Toimiala)  values("Helsinki","032004332","A");
insert into asiakkuudet (Kaupunki, Puhelinnumero,Toimiala) values("Espoo","034363555","B");
insert into asiakkuudet (Kaupunki, Puhelinnumero,Toimiala) values("Helsinki","035545555","B");

insert into myynnit (asiakasID,tilausnumero,maara,tuote,hinta,pvm) values("2","15","1","tuote1","900","2019-09-10");
insert into myynnit (asiakasID,tilausnumero,maara,tuote,hinta,pvm) values("1","16","1","tuote2","800","2019-09-15");
insert into myynnit (asiakasID,tilausnumero,maara,tuote,hinta,pvm) values("1","17","1","tuote1","900","2019-09-15");
insert into myynnit (asiakasID,tilausnumero,maara,tuote,hinta,pvm) values("3","18","1","tuote2","800","2019-09-28");
insert into myynnit (asiakasID,tilausnumero,maara,tuote,hinta,pvm) values("3","19","1","tuote1","900","2019-09-26");
insert into myynnit (asiakasID,tilausnumero,maara,tuote,hinta,pvm) values("4","20","1","tuote1","900","2019-09-25");

Nyt kun meillä on tietokanta, voimme tehdä kyselyjä R:n kautta.
Esim.
sqltk = dbConnect(MySQL(), user='root', password='1234', dbname='datamyynnit', host='localhost')
dbGetQuery(sqltk,"select * from myynnit")

Seuraavaksi on luotava Shinylla UI:

library(shiny)
library(dbConnect)
library(RMySQL)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
    
    
    titlePanel("Kohderyhmätyökalu"),
    
   
    sidebarLayout(
        sidebarPanel(
            helpText("Valitse haluamasi kohderyhmä valikoista ja klikkaa lopuksi 'Printtaa excelinä'-painiketta."),
            
            selectInput("tol",
                        label=("Toimiala"),
                        choices = c("Voit valita useita"='',c("TOL A" ="A",
                                                              "TOL B"="B")),
                                    multiple=T, selected=c("A","B")
                        ),
            
            selectInput("tuote",
                        label=("Myynnit tuotteille"),
                        choices = c("Voit valita useita"='',c("Tuote 1" ="tuote1",
                                                              "Tuote 2"="tuote2")),
                                    multiple=T,selected=c("Tuote 1"="tuote1",
                                                          "Tuote2"="tuote2")),
            
            dateRangeInput("dates", 
                           label = ("Myyntien aikaväli"),
                           start = Sys.Date() - 90, end = Sys.Date() - 1,
                           format = "yyyy-mm-dd",
                           language = "fi",
                           separator = "-"
                           
            ),
            #minimimyynti
            sliderInput("minmyynti", "Minimimyynti:",
                        min = 0, max = 10000, value = 0
            )
                        ,
            actionButton("printti", "Printtaa excelinä")
                   ,
            hr(),
#Lisätään "submitButton", jotta kyselyä ei ajeta jokaisen muutoksen jälkeen automaattisesti.
            submitButton("Päivitä",icon("refresh"),width="200px"),
            helpText("Klikkaamalla yllä olevaa painiketta hakusi ajetaan",style ="font-size:15px; color:red")
                                    
                                    
                                    
                                    
                                    
                                    
                        ),
                        
                      
                        mainPanel(
                            h1("Kohderyhmälista"),
                            tableOutput("tableready")
                        )
            )
        ))


Liitetään seuraavaksi Server-puoli mukaan:

shinyServer(function(input,output) {
    
    sqltk = dbConnect(MySQL(), user='root', password='1234', dbname='datamyynnit', host='localhost')
    
    table <- reactive ({
        tol_selected <-  paste0("'",input$tol,"'",collapse=",")
        tuote_selected <- paste0("'",input$tuote,"'",collapse=",")
            #stringr::str_c(stringr::str_c("'",input$tol,"'"), collapse = ',')
        dbGetQuery(sqltk,
                   #paste0("select * from asiakkuudet where Toimiala in (",tol_selected,")")
           
                    gsub(paste0("select asiakkuudet.*, IFNULL(myynnit2.myynniteur,0) as myynniteur from asiakkuudet
                   left join 
                   (
                   SELECT asiakasID as asID, sum(hinta) as myynniteur FROM myynnit where tuote in (",tuote_selected,")
                   and pvm >= '",input$dates[1],"' AND pvm <= '",input$dates[2],"' group by asiakasID 
                   )
                   as myynnit2 on myynnit2.asID=asiakkuudet.asiakasID
                   where asiakkuudet.Toimiala in (", tol_selected,")
                          and  IFNULL(myynnit2.myynniteur,0) >=",input$minmyynti)
                    ,pattern="\n",replacement=" ")
             
                   
        ) })
    
    
    observeEvent(input$printti, {
        showModal(modalDialog(
            title = "Kohderyhmälistasi on nyt valmis!",
            "Muista käyttää minua myös jatkossa :)",
            footer = modalButton("Sulje")
        ))
        #Excelin printtaus
        dttt <- data.frame(table()) 
        dttt$asiakasID <- as.integer(dttt$asiakasID)
       dttt$Puhelinnumero <- as.character(dttt$Puhelinnumero)
#Valitaan sijainti, johon printatut excelit menevät
       write.csv2(dttt,'C:/Users/aleksi/Documents/testila3.csv', row.names = FALSE)
    })
    
    
    output$tableready <- renderTable({
        
        dt <- data.frame(table()) 
        dt$asiakasID <- as.integer(dt$asiakasID)
        dt
        
    })
    

}



)

#Alla oleva koodipätkä katkaisee yhteydet, kun sessio lopetetaan. 
killDbConnections <- function () {
    
    all_cons <- dbListConnections(MySQL())
    
    print(all_cons)
    
    for(con in all_cons)
        +  dbDisconnect(con)
    
    print(paste(length(all_cons), " connections killed."))
    
}
killDbConnections()

Nyt kun työkalu on valmis, katsotaan hieman sen toimintaa. Esim. Valitaan vain ne toimialan "A" yritykset, joilla on ollut viimeisen kuukauden aikana myyntiä tuotteelle 1 vähintään 500€:lla. Alla kuva haun lopputuloksesta. Aikaa filttereiden valitseminen vei vain muutaman sekunnin, joten aikaa säästyi verrattaen, kuin jos oltaisiin pyydetty analyytikkoa hakemaan tämä tieto manuaalisesti tietokannasta. 




maanantai 14. lokakuuta 2019

R-pähkinä


Ajatellaan, että myynti on kiinnostunut erilaisten myyntipiikkien kestosta. Myyntipäällikkö kysyy, minkä pituisia ovat keskimääräiseltä kestoltaan yli 12K €:n päivämyynnit. Hän on siis kiinnostunut siitä, kuinka kauan yli 12K €:n myynti kestää päivinä, kun se raja ylitetään. Esim. Jos viikon aikana tuo raja ylitetään tiistaina ja keskiviikkona, niin rajan ylittävä kesto on 2 päivää. Jos lisäksi raja ylittyy perjantaina, niin rajan ylittävät kestot ovat päivissä laskettuna 2 (ti, ke) ja 1 (pe). Näiden keskiarvo on 1.5 päivää.

Luodaan datasetti, jossa on myynnit sekä päivämäärä:

library(data.table)
library(ggplot2)
pvm <- seq(from=as.Date("2018/09/01"), to=as.Date("2019/09/15"),by=1)
myynti <- rnorm(length(pvm),mean=10000,sd=2000)
dt <- data.table(pvm,myynti)

#Tehdään kuva myynneistä
ggplot(data=dt,aes(x=pvm,y=myynti))+
  geom_line(color="blue")+
  labs(title="Myynnit 10/2018-09/2019",x="Päivämäärä",y="Myynti €")+
  theme(plot.title = element_text(hjust = 0.5),axis.text.x = element_text(angle = 90))+
  geom_hline(yintercept=12000, linetype="dashed", color = "red")
  


Alla myynnit. Myyntiä kiinnostaa yli 12K €:n ylittävät myynnit (kuvassa myyntiraja punaisella).





Tehtävä on hieman pulmallisempi kuin ensin ehkä vaikuttaa. Mistä tiedämme, milloin 12K € ylitetään ja minä päivänä ylitys loppuu? Entä miten osaamme siirtyä seuraavaan myyntipiikkiin, kun aiemman myyntipiikin kesto on laskettu?

Ratkaisu: 

Ongelman saa ratkaistua yllättävän "siististi". Ensin muutan myynnit binäärimuotoon, jotta saamme eristettyä 12K €:n ylittävät myynnit datasta sekä hyödynnettyä myöhemmin cumsum-funktiota.

dt[,myynnitbi := ifelse(myynti >12000,1,0)]

Alla nähdään, kuinka yli 12K € ylittävät myynnit saavat arvon 1.

pvm
myynti
myynnitbi
2018-09-01
10180
0
2018-09-02
12959
1
2018-09-03
9586
0
2018-09-04
11048
0
2018-09-05
9152
0
2018-09-06
9474
0


Seuraavana käytän cumsum-funktiota, koska sillä pystyy saamaan kaikki ne rivit, joissa myyntiraja on ylittynyt. Esim. yllä olevasta cumsum palauttaa kohdan "0 1", eli rivit 1 ja 2. Cumsum käy tämän jälkeen läpi seuraavan rivin ja palauttaa nollan, koska arvo on nolla. Jos cumsum löytää arvon 1, niin se palauttaa kaiken aina nollaan asti. Eli esim. jos meillä on viisi myyntipiikin ylittävää päivää putkeen, niin cumsum palauttaa 011111. Voimme tallentaa jokaisen tällaisen sarjan summan erilliseen vektoriin ja laskea lopuksi keskiarvon. Huom. summan voi ottaa, koska "1" edustaa aina yhtä päivää, eli esim. "011111" tarkoittaa viittä päivää. 


table_ <- head(dt)
for (i in 0:length(table_$myynnitbi)) {
print(table_$myynnitbi[cumsum(table_$myynnitbi==0) ==i])
}
numeric(0)
[1] 0 1
[1] 0
[1] 0
[1] 0
[1] 0
numeric(0)


Ratkaistaan myyntipiikkien keskimääräinen kesto:

 tulosvektori <- NULL #Alustetaan tulosvektori, johon myyntipiikkien kestot tallennetaan
  for (i in 0:length(dt$myynnitbi)) {
    
    tulosvektori[i+1] <- sum(dt$myynnitbi[cumsum(dt$myynnitbi == 0) == i])}
  print(mean(tulosvektori[tulosvektori>0]))
1.156

Vastaus kysymykseen on 1.16 päivää, eli myyntipiikit eivät olleet kestoltaan juuri päivää pidempiä.