---
output: 
  html_document:
    toc: true
    toc_depth: 2
    toc_float: true
  pdf_document:
    toc: true
    toc_depth: 2
params:
  id:
  - "test:rksp.0"
  - "test:rjmw.0"
  col: NULL
  dynamic: TRUE
  charAlignment: NULL
  topn: 10
  titles: NULL
---


```{r,echo=FALSE}
pver <- packageVersion("DramaAnalysis")
```


```{r setup, include=FALSE, echo=FALSE}
knitr::opts_chunk$set(echo = FALSE)

if (is.null(.Options$qd.datadir)) { 
  DramaAnalysis::setup()
}

getYPositions <- function(x,b,limit=100) {
  rl <- apply(x, 2, function(xx) {
    xx <- as.double(xx)
    cs <- c(0,head(cumsum(xx),-1))
    r <- cs + xx/2
    r[xx<=limit] <- NA
    r  
  })
  rl
}

toFigureName <- function(x) {
  tools::toTitleCase(tolower(x))
}
library(data.table)
library(DramaAnalysis)
library(magrittr)
library(highcharter)
library(stringdist)

#print(class(params$id))
#print(params$id[[2]])
drama <- loadDrama(params$id)
text <- segment(drama$text, drama$segments)
meta <- drama$meta
characters <- drama$characters
if (is.null(params$titles)) {
  titles <- toFigureName(meta$documentTitle)
} else {
  titles <- params$titles
}
names(titles) <- params$id
```


```{r}
if (is.null(params$charAlignment)) {
  
}
```

---
title: "QuaDramA Edition Comparison"

---

This report shows a number of quantitative properties extracted from several plays. 
The report assumes the plays to be different variants *of the same text* (what ever
that means).

# Meta data

```{r, results="asis"}


knitr::kable(meta,
             col.names = c("Corpus", "Text-Id", "Title", "Language", "Author name", "Author Id", "Translator name", "Translator Id", "Year written", "Year printed", "Year premiered", "Year translated"),
             format = "markdown")

```


# Structure {.tabset}



## Overview

```{r}
tbl <- text[,.(Acts=length(unique(begin.Act)),
               Scenes=length(unique(begin.Scene))),
            .(corpus,drama)]
rownames(tbl) <- paste(tbl$corpus,tbl$drama,sep=":")
tblm <- as.matrix(tbl[,3:ncol(tbl)])

barplot(tblm,
        beside=TRUE,
        legend.text = titles[rownames(tbl)],
        col=params$col,args.legend = c(x="bottom"))

#knitr::kable(tbl)

```

## Differences

# Characters {.tabset}

## Number of Characters {.tabset}

```{r}
tbl <- text[,.(Characters=length(unique(Speaker.figure_surface))),
            .(corpus,drama)]
rownames(tbl) <- titles[paste(tbl$corpus,tbl$drama,sep=":")]
tblm <- as.matrix(tbl[,3:ncol(tbl)])
```

### Overview

```{r}
tbl <- text[,.(Characters=length(unique(Speaker.figure_surface))),
            .(corpus,drama)]
rownames(tbl) <- titles[paste(tbl$corpus,tbl$drama,sep=":")]
tblm <- as.matrix(tbl[,3:ncol(tbl)])
rownames(tblm) <- rownames(tbl)
barplot(tblm,
        beside=TRUE,
        legend.text = rownames(tbl),
        col=params$col, args.legend = c(x="bottom"))

#knitr::kable(tbl)

```

### Table

#### Absolute numbers

```{r, results="asis"}
knitr::kable(tblm, format="markdown", row.names = TRUE)
```

#### Differences
```{r}
knitr::kable(as.matrix(dist(tblm)))
```

## Spoken words {.tabset}

### Overview

This plot shows the spoken words of the most talkative `r params$topn` characters per play.

```{r}

fstat <- characterStatistics(drama) %>%
  filterCharacters(drama, n=params$topn) %>%
  characterNames(drama)

xt <- xtabs(tokens ~ paste(corpus,drama,sep=":")+character,data=fstat)

attr(xt, "class") <- NULL 
attr(xt, "call") <- NULL 
#barplot(xt, beside=TRUE,las=3)

xt <- as.data.frame(t(xt))
colnames(xt) <- titles[colnames(xt)]
hc <- highchart()

hc <- hc_yAxis(hc, max=max(xt))
hc <- hc_xAxis(hc, categories=rownames(xt))

for (i in 1:ncol(xt)) {
  hc <- hc_add_series(hc, xt[,i], type="column", name=colnames(xt)[i])
}

hc

```

### Table

The table shows token numbers for all characters.

```{r, results="asis"}
fstat <- characterStatistics(drama) %>%
  characterNames(drama)

xt <- xtabs(tokens ~ paste(corpus,drama,sep=":")+character,data=fstat)
attr(xt, "class") <- NULL 
attr(xt, "call") <- NULL 
xt <- as.data.frame(t(xt))
colnames(xt) <- titles[colnames(xt)]


knitr::kable(xt, format="markdown")


```


## Utterances {.tabset}

### Lengths

This plot shows the distribution of utterange lengths for the top `r params$topn` characters in each play. If two characters are aligned, their box is shown side by side. More on [box plots in Wikipedia](https://en.wikipedia.org/wiki/Box_plot). Dots outside of the box indicate potential outliers, color shows the play they belong to.

```{r}
ustat <- utteranceStatistics(drama) %>%
  filterCharacters(drama, n = params$topn) %>%
  characterNames(drama)

if (is.null(params$col)) {
  col = "black"
} else {
  col = params$col[1:length(params$id)]
}

hcboxplot(x=ustat$utteranceLength, 
          var=as.character(ustat$character), 
          var2=as.character(ustat$drama),
          color=col
          )


```

### Table

This table records information about *every utterance* in each play. It is therefore very long.

```{r, results="asis"}

knitr::kable(ustat, format="markdown")

```


```{r, eval=FALSE}



utteranceDistances <- function(t) {
  tagg <- t[,.(text=paste0(Token.surface, collapse=" ")),.(corpus,drama,begin, Speaker.figure_surface)]
  pairs <- t(combn(nrow(tagg),2))
  for(i in 1:nrow(pairs)) {
    row_a <- pairs[i,1]
    row_b <- pairs[i,2]
    
  }
  
}

text[,
     mcp:=max(utteranceEnd),
     .(corpus,drama)][,
                      .(utteranceLength=.N,rbegin=utteranceBegin/mcp),
                      .(corpus,drama,utteranceBegin,Speaker.figure_surface)][]

```

# Presence and Utterances {.tabset}

```{r}

ustat <- utteranceStatistics(drama, normalizeByDramaLength = FALSE) %>%
  filterCharacters(drama, n=params$topn) %>%
  characterNames(drama)

```

## All Utterances
```{r}
par(mar=c(1,9,1,0),xpd=FALSE)

for (id in params$id) {
  splid <- strsplit(id,":",fixed=TRUE)[[1]]
  plot(ustat,
       xlab="", 
       main=toFigureName(meta[meta$corpus==splid[1] & meta$drama==splid[2],3]))
}
```


# Configuration and Copresence {.tabset}

```{r, fig.height=10}
configs <- lapply(split(drama), function(x) {
  c <- configuration(x, onlyPresence = TRUE, 
                     segment = "Scene") %>%
    characterNames(x)
  copr <- as.matrix(c) %*% t(as.matrix(c))
  rownames(copr) <- c$character
  colnames(copr) <- c$character
  
  copr <- reshape::melt.array(copr)
  copr$drama <- x$meta$drama
  copr
})

allcopresence <- Reduce(rbind, configs)
allcopresence$X1 <- as.character(allcopresence$X1)
allcopresence$X2 <- as.character(allcopresence$X2)
```