---
title: "Tekst"
author: "Jaagup Kippar"
date: "30 mai 2016"
output: html_document
---
# Tekst ja aeg

Kataloog ja teek
```{r }
setwd("c:/jaagup/16/analyytika")
library(stringr)
```

## Teksti lugemise katsetused

Esimesed viis rida
```{r }
readLines("first_test.csv", n=5)
```

Andmed massiivi
```{r }
m=readLines("first_test.csv", n=5)
```
Esimene rida
```{r }
cat(m[1])
```
Kogu massiiv
```{r }
cat(m)
```
Koos reavahetusega
```{r }
cat(m,sep="\n")
```
Paste võtab iga elemendi eraldi
```{r }
paste(m)
```

## Tegelik lugemine

```{r }
m=readLines("first_test.csv")
for(i in 1:length(m)){
  c=str_count(m[i], '"')
  if(c %% 2 !=0){ #real olevate paaritu arvu jutumärkide korral
    #semikoolonile mitte vastu puutuv jutumärk kõrvaldatakse
    cat(m[i])
    m[i]=gsub('([^;])"([^;])', '\\1\\2', m[i])
    cat(m[i])
  }
}
```

### Analoog:

Püüan tsüklist loobuda ning teha nõnda, nagu juhendis õpetati
```{r }
m=readLines("first_test.csv")
```
Jutumärkide arv ridade kaupa
```{r }
arvud=str_count(m, '"')
head(arvud)
```

Read, kus jutumärke paaritu arv. Hetkel paistab olema vaid üks selline rida, kuid neid võib ka rohkem tulla.
```{r }
reanr=which(arvud %% 2 != 0)
reanr
```
Vastava rea sisu
```{r }
m[reanr]
```

Otsitud jutumärgi asukoht. Kuna muud jutumärgid peavad alles jääma, siis konkreetse rea pealt otsin kohta, kus on jutumärk koos temale järgneva d-tähega. Koha juures näidatakse algus ja ots.
```{r }
koht=str_locate(m[reanr], '"d')
koht
```
Paistab olema maatriksi klassist ning meeldetuletuseks pärast vahepealset otsimist panen kirja, et maatriksi lahtrite poole võib pöörduda nii numbrite kui pealkirjade kaudu.
```{r }
class(koht)
koht[1, "start"]
```

Asendan jutumärgi koos järgneva d-tähega stringiga "xd". Katsete tulemusena selgus, et asendatav koht peab olema sama pikk (nagu C puhul tähemassiividega tegutsedes)
```{r }
substr(m[reanr], koht[1, "start"], koht[1, "end"])="xd"
```

Rida pärast asendamist, segava jutumärgi asemel on x-täht
```{r }
m[reanr]
```

## Lühem variant faili lugemiseks ja segava jutumärgi eemaldamiseks
```{r }
m=readLines("first_test.csv")
arvud=str_count(m, '"')
reanr=which(arvud %% 2 != 0)
koht=str_locate(m[reanr], '"d')
substr(m[reanr], koht[1, "start"], koht[1, "end"])="xd"
```



Muudetud tekstist andmed sisse
```{r }
andmed=read.table(file=textConnection(paste(m, sep="\n")), sep=";", header=TRUE, stringsAsFactors = FALSE)
head(andmed)
```

Jäetakse alles need andmed, kus kolm vastusetulpa + ajatulp kokku sisaldavad midagi
```{r }

andmed=andmed[paste(andmed$aeifl,andmed$tvil,andmed$myktin, andmed$test_start_time, sep="")!="", ]
```

Esimeses vastusetulbas puuduvate andmete leidumine
```{r }
andmed$aiefl==""
```

Teises andmetulbas puuduvate väärtuste esinemise kohad
```{r }
which(andmed$tvil=="")
```

Kolmandas andmetulbas puuduvate väärtuste leidmise kohad
```{r }
which(andmed$myktin=="")
```

Püüan mõlemite ühiseid puuduvaid kohti saada, kuid kahe &-märgiga saan tühjuse. Manuaali lugedes leian, et üldjah oleks siis, kui mõlemil tingimusel kõik tunnused jahid on. Kuna aga esimene on FALSE siis edasi ei vaadata ja kokku ongi FALSE
```{r }
which(andmed$myktin=="" && andmed$tvil=="") # ei toimi
```

&-märgi katsetused
```{r }
c(TRUE, TRUE, TRUE) & c(TRUE, TRUE, TRUE)
c(TRUE, TRUE, TRUE) && c(TRUE, TRUE, TRUE)

c(TRUE, FALSE, TRUE) & c(TRUE, TRUE, TRUE)
c(TRUE, TRUE, TRUE) && c(TRUE, TRUE, TRUE)
```

Ühe &-märgiga jaatus paistab toimima
```{r }
which(andmed$myktin=="" & andmed$tvil=="")
```

Aja puudumise kohad
```{r }
which(andmed$test_start_time=="")

```

Kas konkreetses lahtris väärtus puudub
```{r }
andmed[206, "tvil"]==""
```

Sama arvuna
```{r }
as.numeric(andmed[206, "tvil"]=="")
```

## Puuduvate väärtuste arvu otsimine rea kohta

Iga rea kohta käivitatakse funktsioon, kus käiakse läbi selle rea kõik veerud, kontrollitakse väärtuse puudumist (võrdumine tühja sõnega) ning summeeritakse puuduvad väärtused (nende arv) kokku. Nii saab iga rea kohta arvu, et mitu väärtust selles puudub. 

Kõhutunne ütleb, et seda peaks saama ka kuidagi lihtsamalt/elegantsemalt teha. Apply-le ridade kaupa miski funktsioon ette anda - aga mõned erisugused katsed igatahes selles suunas sihile ei viinud.
```{r }
puuduvaid=sapply(1:nrow(andmed), function(reanumber){sum(
  sapply(1:ncol(andmed), function(veerunumber){as.numeric(andmed[reanumber, veerunumber]=="")})
)})
head(puuduvaid)
```

Ridade arvu jaotus puuduvate väärtuste arvu kaupa
```{r }
table(puuduvaid)
```

Millistel reanumbritel on kolm puuduvat väärtust
```{r }
which(puuduvaid==3)
```

Need read ise (päis)
```{r }
head(andmed[puuduvaid==3, ])
```

Ja read, kus on muu arv (vähem) puuduvaid
```{r }
head(andmed[puuduvaid!=3, ])
```

Ja read, kus on muu nullist suurem arv puudujaid
```{r }
head(andmed[puuduvaid!=3 & puuduvaid>0, ])
```

Jätame alles vaid read, kus on vähem kui kolm puuduvat väärtust
```{r }
andmed=andmed[puuduvaid<3, ]

```
Andmete ettevalmistamise lõpp

---

## Teksti otsimiskäskude katsetused

Vastuse õigsuse hindamise tarbeks

Kas a sisaldub kalas - jah (1)
```{r }
grep("a", "kala")
```

b ei sisaldu
```{r }
grep("b", "kala")
```

Uuritavad tähed
```{r }
tahed="abc"
```

Üksiku tähe kättesaamiseks peavad algus ja lõpp kattuma
```{r }
substr(tahed, 2, 2)
```
Tähtede arvu kätte saamiseks sobib nchar (mitte length)
```{r }
nchar(tahed)
```

Kas konkreetne täht sisaldub sõnas "kaba"

a on, b on, c ei ole
```{r }
sapply(1:nchar(tahed), function(nr){grep(substr(tahed, nr, nr), "kaba")})
```

Summana kokku loetu, et mitu tähtede stringis olevat sümbolit leidub sõnas "kaba". Sarnaselt siis võimalik vaadata, et kui palju lapse pakutud tähti on pihta läinud.
```{r }
sum(unlist(sapply(1:nchar(tahed), function(nr){grep(substr(tahed, nr, nr), "kaba")})))
```

Sama tulemus hulgatehete abil. Teksti muutmiseks vektoriks eraldi väike funktsioon, kuna lühemat lahendust ei leidnud.
```{r }
 vektoriks <- function(tekst){
     sapply(1:nchar(tekst), function(x) substring(tekst, x, x))  
 }
 pakutud=vektoriks(tahed)
 uuritav=vektoriks("bcd")
 oiged=intersect(pakutud, uuritav)
 oiged
 valed=setdiff(pakutud, uuritav)
 valed
 length(oiged)
 length(valed)
```
Skoori arvutus
```{r }
 length(oiged)-length(valed)
```


## Tegelike andmete juurde

```{r }
head(andmed)
veerunr=2
```

Veeru pealkiri paistab klappima õigete vastustähtedega
```{r }
names(andmed)[veerunr]
```

Konkreetse veeru kohta pihtaläinud tähtede arv
```{r results='hide'}
sapply(1:nrow(andmed), function(reanr) sum(unlist(sapply(1:nchar(names(andmed)[veerunr]), function(veerutahenr){grep(substr(names(andmed)[veerunr], veerutahenr, veerutahenr), andmed[reanr, veerunr])}))))
```

Sama valemi abil lisatulp ning sealt nähtavale esimesed read
```{r }
head(cbind(andmed, oigeid1=sapply(1:nrow(andmed), function(reanr) sum(unlist(sapply(1:nchar(names(andmed)[veerunr]), function(veerutahenr){grep(substr(names(andmed)[veerunr], veerutahenr, veerutahenr), andmed[reanr, veerunr])}))))))

```

Vastuseveergude 2-4 pihtaläinud tähtede arvu summa
```{r results='hide'}

sapply(2:4, function(veerunr){
  sapply(1:nrow(andmed), function(reanr) sum(unlist(sapply(1:nchar(names(andmed)[veerunr]), function(veerutahenr){grep(substr(names(andmed)[veerunr], veerutahenr, veerutahenr), andmed[reanr, veerunr])}))))
})


```


Samast esimesed read nähtavale
```{r}
head(cbind(andmed, sapply(2:4, function(veerunr){
  sapply(1:nrow(andmed), function(reanr) sum(unlist(sapply(1:nchar(names(andmed)[veerunr]), function(veerutahenr){grep(substr(names(andmed)[veerunr], veerutahenr, veerutahenr), andmed[reanr, veerunr])}))))
})))

```

Katse õigete vastuste summa apply abil välja arvutada
```{r results='hide'}
apply(sapply(2:4, function(veerunr){
  sapply(1:nrow(andmed), function(reanr) sum(unlist(sapply(1:nchar(names(andmed)[veerunr]), function(veerutahenr){grep(substr(names(andmed)[veerunr], veerutahenr, veerutahenr), andmed[reanr, veerunr])}))))
}), 1, sum)

```

Samast esimesed read nähtavale
```{r}

head(cbind(andmed, summa=apply(sapply(2:4, function(veerunr){
  sapply(1:nrow(andmed), function(reanr) sum(unlist(sapply(1:nchar(names(andmed)[veerunr]), function(veerutahenr){grep(substr(names(andmed)[veerunr], veerutahenr, veerutahenr), andmed[reanr, veerunr])}))))
}), 1, sum)))



```

## Lahendus funktsioonide abil

Valemid ja arvutused kippusid üksteise otsa lisades korraga tabamiseks liialt suureks kasvama. Kui nüüd sinna lisada veel valede pakkumiste leidmine ja maha lahutamine, siis keerukus kasvaks veelgi. Jagan tegevused osadeks. Funktsioon leidmaks, mitu õiget oli pakutute hulgas

```{r }
oigeidlahtris <- function(pakutud, oiged){
  pakutud=tolower(pakutud)
  sum(unlist(sapply(1:nchar(oiged), function(veerutahenr){
    grep(substr(oiged, veerutahenr, veerutahenr), pakutud)
  })))
}

```
Funktsiooni katsetus
```{r}

oigeidlahtris("abc", "bcd")

```
Valede leidmiseks arvestan kõigepealt ainult tähti a-z, et eraldajaks pandud komad, tühikud ja muud sümbolid ei segaks.
```{r}

#sum vaid vastuse arvuliseks muutmiseks
valesidlahtris <- function(pakutud, oiged){
  pakutud=tolower(pakutud)
  pakutud=str_replace_all(pakutud, "[^a-z]", "")
  sum(unlist(sapply(1:nchar(pakutud), function(veerutahenr){
    1-sum(grep(substr(pakutud, veerutahenr, veerutahenr), oiged))
  })))
}
```
Vale oleks siis a, aga mitte tühik
```{r}
valesidlahtris("ab c", "bcd")

```
Lahtri üldskoori leidmiseks tuleb õigetest valed maha lahutada
```{r}
lahtriskoor <- function(pakutud, oiged){
  oigeidlahtris(pakutud, oiged)-valesidlahtris(pakutud, oiged)
}

```
Õiged on b ja c
```{r}
oigeidlahtris("ab c", "bcd")

```
Valena maha a
```{r}
lahtriskoor("ab c", "bcd")

```

Käsk grep annab vaste mitteleidmisel tulemuseks integer-tüüpi nulli. 
```{r}
grep("a","b")
```
Tehet aga ei taheta vastu võtta
```{r}
1-grep("a","b")
```
Selle sai küll numbriks muuta
```{r}
as.numeric(grep("a","b"))
```
Aga sellegipoolest polnud võimalik tehtes kasutada. Kiusatus on mitteleidumisele panna vastuseks 1 ja leidumisele null ehk siis tehe 1-grep("a", "b")
```{r}
1-as.numeric(grep("a","b"))
```
Toimiv lahendus õnnestus tekitada sum-funktsiooni abil - ehkki arvatavasti leidub kusagil ka mõni loogilisem moodus.
```{r}
1-sum(grep("a","b"))
```


Õigete arv tulpade kaupa. 
```{r results='hide'}

sapply(2:4, function(veerunr){
  sapply(1:nrow(andmed), function(reanr) {oigeidlahtris(andmed[reanr, veerunr], names(andmed)[veerunr] )})
})


```

Valede arv tulpade kaupa
```{r results='hide'}
sapply(2:4, function(veerunr){
  sapply(1:nrow(andmed), function(reanr) {valesidlahtris(andmed[reanr, veerunr], names(andmed)[veerunr] )})
})


```

Lahtriskoor tulpade kaupa
```{r results='hide'}
sapply(2:4, function(veerunr){
  sapply(1:nrow(andmed), function(reanr) {lahtriskoor(andmed[reanr, veerunr], names(andmed)[veerunr] )})
})


```
Esimeste ridade lahtriskoor
```{r}
head(
cbind(andmed, 
sapply(2:4, function(veerunr){
  sapply(1:nrow(andmed), function(reanr) {lahtriskoor(andmed[reanr, veerunr], names(andmed)[veerunr] )})
})
))


```
Skoor andmestiku külge tulpadena. Jällegi mõte, et äkki annaks sellise funktsiooni rakendamist andmestiku ridadele mõne andekama käsuga teha, kui sapplyga veerud ja read eraldi läbi käies?
```{r}
andmed=cbind(andmed, 
sapply(2:4, function(veerunr){
  sapply(1:nrow(andmed), function(reanr) {lahtriskoor(andmed[reanr, veerunr], names(andmed)[veerunr] )})
})
)


```
Lisatulpadega andmete esimesed read.

```{r}
head(andmed)

```
Koondskoori arvutamine. Saaks arvatavasti ka eelnevate tulpade kaudu (tekkinud tulbad salapäraste nimedega 1, 2 ja 3, aga sum-funktsioon teeb praegu sama töö ära)
```{r}
andmed$koondskoor=sapply(1:nrow(andmed), function(reanr) {
  sum(
  sapply(2:4, function(veerunr){lahtriskoor(andmed[reanr, veerunr], names(andmed)[veerunr] )})
  )
})


```
Algusots koos koondskooriga
```{r}
head(andmed)


```
Tulemuste jaotus kolme ülesande peale kokku
```{r}
hist(andmed$koondskoor, main="Tulemuste jaotus", xlab="Punktide arv", ylab="Sagedus")

```
Arvuline väljund nendest
```{r}
table(andmed$koondskoor)

```
Suvaliste pakkumiste pealt tulnud suured ja harvad negatiivsed skoorid eemaldatud, jaotus histogrammina.
```{r}
hist(andmed$koondskoor, xlim=c(-5, 15), main="Tulemuste jaotus", xlab="Punktide arv", ylab="Sagedus")
```

## Kuupäevad

Nädalapäev
```{r }
weekdays(as.POSIXct("2014-12-08 09:05:43"))
```

Kuupäev ajast
```{r }
as.Date(as.POSIXct("2014-12-08 09:05:43"))
```

Tulba test_start_time muutmine POSIXct tüüpi
```{r }
andmed$test_start_time=as.POSIXct(andmed$test_start_time)
```

Päevade kaupa soorituste arvude kätte saamine. Table-funktsioonist väljund värskelt leitud funktsiooniga as.data.frame.table
```{r }
paevakogused=as.data.frame.table(table(as.Date(andmed$test_start_time)))
colnames(paevakogused)=c("soorituskuupaev", "kogus")
head(paevakogused, 10)
head(paevakogused[rev(order(paevakogused$kogus)), ], 10)
```

## Vahemikus leidmine, millisel päeval kui palju teste

Vahemiku algus ja ots
```{r }
ajavahemik=range(as.Date(andmed$test_start_time))
```
Selle sees kõik olemasolevad päevad
```{r }
koikpaevad=data.frame(seq(from=ajavahemik[1], to = ajavahemik[2], by=1))
```
Ja näide, et hakati õigesti lugema
```{r }
head(koikpaevad)

```
Tulbale arusaadav nimi
```{r }
names(koikpaevad)=c("kuupaev")
```

Kõikide päevade külge eraldi tulbana testitud päevadel saadud tulemused
```{r }
kogused=merge(koikpaevad, paevakogused, by.x="kuupaev", by.y="soorituskuupaev", all=TRUE)
```
Väljund ekraanile
```{r }
head(kogused)
```

Kui tol päeval teste ei tehtud, siis selle päeva testide arv on null
```{r }
kogused[is.na(kogused$kogus), "kogus"]=0
```
Tulemuse kontroll
```{r }
head(kogused)
```

Summeeritud kogused päevade kaupa
```{r }
kumulatiivnekogus=cumsum(kogused$kogus)
```

Algusots kontrolliks
```{r }
head(kumulatiivnekogus)
```

Kasvukõver nähtavale
```{r }
plot(kumulatiivnekogus, xlab="Päeva number")
```
Tulemus koos ajateljega
```{r }
plot(kogused$kuupaev, kumulatiivnekogus)

```

Testide arvud nädalapäevade kaupa
```{r }
table(weekdays(andmed$test_start_time))

```
Nädalapäev omaette tulbaks
```{r }
andmed$nadalapaev=weekdays(andmed$test_start_time)
```

Nädalapäevade nimed sisulisse järjestusse
```{r }
andmed$nadalapaev=factor(andmed$nadalapaev, levels=c("esmaspäev", "teisipäev", "kolmapäev", "neljapäev", "reede", "laupäev", "pühapäev"), ordered=TRUE)
```
Andmete algusotsa kontroll
```{r }
head(andmed)
```
Tüübi kontroll
```{r }
class(andmed$nadalapaev)
```
Jaotus nädalapäevade kaupa - sedakorda sisuliselt järjestatult
```{r }
table(andmed$nadalapaev)
```
Koondskoorid nädalapäevade kaupa - keskmised ja standardhälbed
```{r }
aggregate(andmed$koondskoor, by=list(andmed$nadalapaev), FUN=function(x)c(keskmine=mean(x), standardhalve=sd(x)))

```
Koondskoori väärtused nädalapäeviti - karp ja vurrud. 
Boxplot-käsklusega nõnda kergelt ei tulnud
```{r }
plot(koondskoor ~ nadalapaev, andmed, las=2)
#boxplot(andmed$nadalapaev, andmed$koondskoor)
```

Testide sooritamise arv tundide kaupa
```{r }
table(format(andmed$test_start_time, "%H"))
```

Jällegi table-tulemuse lugemisraskused. Kahekordne transponeerimine nagu mõjus hästi. Aga tagantjärele asendasin funktsiooniga as.data.frame.table().
```{r }
#tunnikaupa=t(t(table(format(andmed$test_start_time, "%H"))))
tunnikaupa=as.data.frame.table(table(format(andmed$test_start_time, "%H")))
colnames(tunnikaupa)=c("tund", "testidearv")
```

Tunnid, kus tehti vähemasti 30 testi
```{r }
tunnikaupa[tunnikaupa$testidearv>=30, ]
```

Koondskoori jaotus tundide kaupa
```{r }
koond=aggregate(andmed$koondskoor, by=list(format(andmed$test_start_time, "%H")), FUN=function(x)c(keskmine=mean(x), standardhalve=sd(x), kogus=length(x)))

#subset(koond, x.kogus>=30)
```

Tulpasid paistab rohkem, aga kergesti kätte ei saa.
```{r }
head(koond)
```

Kui arvestada, et x on omaette maatriks ning sealt vaadata, millise rea kogus ületab kolmekümmet, siis võimalik ka üldtabeliset sobivad read koos tundidega kuvada. 
```{r }
koond[koond$x[,"kogus"]>30, ]
class(koond)
```

Otsesed üldtabeli tulbad aga vaid grupeerimistunnus ja vaste 
```{r }
names(koond)
```
Vaste on omaette maatriks, mis data.frame ühte tulpa pressitud
```{r }
class(koond$x)
```
Trikid andmete kätte saamiseks - et oleksid omaette tulpadena kasutatavad. Äkki on ka mõni parem moodus olemas kokkupressitud tulpade kätte saamiseks?
```{r }
koond3=cbind(koond$x, tund=as.numeric(koond$Group.1))
koond3
```
Tulbad nüüd õnneks eraldi olemas
```{r }
colnames(koond3)
```
Ja saab sobivad read ka välja kuvada - tundide andmed, kus rohkem teste tehtud. 
```{r }
koond3[koond3[, "kogus"]>=30,]
```