<br>

```{r setup, echo=FALSE}
pacman::p_load(knitr, rgl, shiny, networkD3,stringi, gdtools, shiny)
knit_hooks$set(webgl = hook_webgl)
knitr::opts_chunk$set(echo=FALSE, messages=FALSE, warnings=FALSE)
# options(digits = 4)
```




```{r captions, echo=FALSE}
pacman::p_load_current_gh("adletaw/captioner", 'trinker/testing', 'ramnathv/rCharts', 'trinker/plotflow', 'trinker/textshape', 'jcizel/scatterMatrixD3')
pacman::p_load(tidyverse, base64enc, d3heatmap, stringi, qdapTools, viridis, ggplot2)

pacman::p_load_current_gh('davidgohel/ggiraph')

sankeydat <- readr::read_rds('sankey.rds')

# colkey <- data_frame(
# person = sort(unique(gsub("\\.$", "", unname(unlist(lapply(lapply(sankeydat[c(1, 2, 4, 5)], `[[`, 1), `[[`, 1)))))),
#     color = plotflow::ggcolors(8)[c(1:4, 4, 5:8)]
# )



tb <- captioner(prefix = "Table")
fg <- captioner(prefix = "Figure")

fg1 <- fg(name = "randu1", caption = "An interactive 3-D scatterplot of [RANDU](https://en.wikipedia.org/wiki/RANDU) generated data.  While the data was intended to be random, rotating the plot will eventually reveal non-random structures in the data.  Try rotating this scatterplot to reveal the non-random structures.")

fg2 <- fg(name = "randu2", caption = "An interactive 3-D scatterplot of R's `runif` generated data.  Unlike the RANDU generated data, rotating the plot will not reveal non-random structures in the data.")

heat <- fg(name = "heat1", caption = "This interactive heatmap shows average sentiment and readability scores for the two teachers across the 10 interview questions.  The color has been scaled by column with higher values in darker blue and lower values in yellow.  Rows (Person + Question) have been reordered according to hierarchical clustering.  The heat map provides value details activated by hovering the cursor over a cell.  Additionally brushed zooming is enabled to focus one specific portions of the heat map.")

filtbar <- fg(name = "filtbar1", caption = "This interactive bar plot shows the word counts for the 7th grade classroom observations.  The plot enables filtering out people (e.g., filter teachers to better compare within students).  The plot also supports switching the plot type between dodged and stacked positionings.  Double click a person to select just observation for them.")


gantt <- fg(name = "gantt1", caption = "This interactive Gantt plot shows the durations of participant talk across Observation 1, a 7th grade ELA class taught by Ms. Baginski.  The hover interaction enables instant access querying to the underlying text in each of the segment geoms.")

sankey <- fg(name = "sankey1", caption = "This interactive Sankey diagram has an advantage over the often overcrowded static version in that a mouse over of the nodes or edges highlights the attached edges, allowing for \"untangling\" the over-plotting.  This Sankey shows the flow of discourse between participants with the edge thickness representing number of words.  Additionally, edge and node counts are available as a tool-tip on demand without cluttering the plot region.")

scatty <- fg(name = "scatty1", caption = "This interactive scatterplot matrix prvoides linked brushing with highlighting for average sentiment and readability scores for the two teachers across the 10 interview questions.  In addition, the user may filter and select rows and variables that are of inerest via a check box interface or color on the categorical person variable.")
```


```{r results="asis"}
cat("
<style>

.grid {
  width: 800px;
  height: 800px;
}

.one-one {
  display: inline-block;
  float: left;
  width: 380px;
  height: 380px;
}

.one-two {
  display: inline-block;
  float: right;
  width: 380px;
  height: 380px;
}

.two-one {
  display: inline-block;
  float: left;
  margin-top: 10px;
  width: 380px;
  height: 380px;
}

.two-two {
  display: inline-block;
  float: right;
  margin-top: 10px;
  width: 380px;
  height: 380px;
}

iframe {
  -moz-transform: scale(0.75, 0.75); 
  -webkit-transform: scale(0.75, 0.75); 
  -o-transform: scale(0.75, 0.75);
  -ms-transform: scale(0.75, 0.75);
  transform: scale(0.75, 0.75); 
  -moz-transform-origin: top left;
  -webkit-transform-origin: top left;
  -o-transform-origin: top left;
  -ms-transform-origin: top left;
  transform-origin: top left;
}

</style>
")
```


# RANDU Exposed

## RANDU Output

```{r testgl1, webgl=TRUE}
seed <- as.double(1)
RANDU <- function() {
    seed <<- ((2^16 + 3) * seed) %% (2^31)
    seed/(2^31)
}

set.seed(10)
dat <- t(sapply(1:2000, function(i){
    U <- c(RANDU(), RANDU(), RANDU(), RANDU(), RANDU())
    round(U[1:3], 6)
}))


plot3d(dat, col="black", size=3, xlab='x', ylab='y', zlab='z')
```
`r fg1`

## R Random Uniform Output

```{r testgl2, webgl=TRUE}
dat2 <- matrix(runif(6000, 0, 1), ncol=3)
plot3d(dat2, col="black", size=3, xlab='x', ylab='y', zlab='z')
```

`r fg2`



# Mouse-Over Heatmap


```{r}
mean2 <- function(x) mean(x, na.rm = TRUE)
mat <- sentiread %>%
    ungroup() %>%
    mutate(rows = paste(gsub("^[^ ]+ ", "", Person), stringi::stri_pad_left(Question_Number, 2, pad="0"), sep = ": ")) %>%
    select(rows, Word_Count, Sentiment_turk:Trust_turk, Flesch_Kincaid:Automated_Readability_Index) %>%
    select(-None_turk) %>%
    rename(ARI = Automated_Readability_Index) %>%
    group_by(rows) %>%
    summarize_all(mean2) %>%
    as.data.frame() %>%
    setNames(gsub("_turk", "", names(.))) %>%
    qdapTools::df2matrix() 
d3heatmap(mat, scale = "column", colors = colorRampPalette(c("yellow", "blue"))(n = 100), cexRow = .7, Colv = FALSE)
```
<p></p>
`r heat`


### Questions:

```{r, results='asis', comment=NA, warn=FALSE}
sentiread %>%
    ungroup() %>%
    select(Question_Number, Question) %>%
    distinct() %>%
    mutate(Question = gsub("[^ -~]", "'", Question)) %>%
    # mutate(Question = unlist(lapply(Question, function(x) paste(strwrap(x, 50), collapse = "</br>") ))) %>%
    select(Question) %>%
    unlist() %>%
    # lapply(strwrap, 80) %>%
    # lapply(function(x) lapply(x, tags$br)) %>%
    lapply(tags$li) %>%
    tags$ol()
```
    
# Filtering Bar Plot

```{r, results = 'asis'}
barfildat <- rinker_observations %>%
    filter(Observation %in% c(4, 5, 1, 2)) %>% #head()
    mutate(Observation = paste0("Obs: ", Observation, "  ", Subject)) %>%
    select(Observation, Person, Word_Count) %>%
    filter(Person != "Students") %>%
    na.omit() %>% tbl_df() %>% #print(n=Inf)
    group_by(Observation, Person) %>%
    summarize(Words = sum(Word_Count)) # %>%print(n=Inf)

n1 <- nPlot(Words ~ Observation, group = "Person", data = barfildat, 
  type = 'multiBarChart')
n1$save("p2.html", standalone = TRUE)
```

<iframe src="p2.html" align="center" width="1200" height="450" frameBorder="0"></iframe>
`r filtbar`

# Mouse Over Gantt Plot

```{r, fig.width =8, fig.height = 3}
# g <- rinker_observations %>%
#     ungroup() %>%
#     filter(Observation == 1 ) %>%
#     filter(Person != 'Students' & !is.na(Word_Count) & !is.na(Dialogue)) %>% # nrow()
#     mutate(Endmark = stringi::stri_extract_first_regex(Dialogue, "[?.!]$") %>% unlist()) %>%
#     select(Person, Endmark, Word_Count, Dialogue) %>%
#     tbl_df() %>%
#     na.omit() %>%
#     mutate(
#         start = starts(Word_Count),
#         end = ends(Word_Count),
#         start = ifelse(Word_Count < 25, start -15, start),
#         end = ifelse(Word_Count < 25, end + 15, end),
#         Dialogue = gsub("'", "`", Dialogue),
#         Endmark = ifelse(is.na(Endmark), "NULL", Endmark)
#     ) %>% #View()
#     ggplot(aes(x = start,  y = Person, xend = end, yend = Person, color = Endmark) ) +
#         theme_minimal() +
#         ggiraph::geom_segment_interactive(aes(tooltip = Dialogue), size = 7) +
#         ylab(NULL) +
#         xlab("Duration (Words)") +
#         scale_color_manual(values = c('red', 'grey60', 'blue'))

# ggiraph(code = print(g), width = 1, hover_css = "cursor:pointer;fill:red;stroke:red;", width_svg = 8, height_svg = 3)
```

<iframe src="ganttss.html" align="center" width="1300" height="575" frameBorder="0"></iframe>
`r gantt`


# Mouse-Over Sankey
    
<div class="grid">
  <div class="one-one">
<b>Obs. 1: ELA</b> 
```{r, fig.width=4, fig.height=3}
suppressMessages(sankeyNetwork(Links = sankeydat[[1]][[2]], Nodes = sankeydat[[1]][[1]], Source = 'source',
    Target = 'target', Value = 'value', NodeID = 'name',
    fontSize = 12, nodeWidth = 30))

```    
  </div>

  <div class="one-two">
<b>Obs. 2: Math</b> 
```{r, fig.width=4, fig.height=3}
# cols <- data_frame(name = gsub("\\.$", '', sankeydat[[2]][[1]][[1]])) %>%
#     left_join(colkey, by = c('name' = 'person')) %>%
#     `[[`(1)
# 


suppressMessages(sankeyNetwork(Links = sankeydat[[2]][[2]], Nodes = sankeydat[[2]][[1]], Source = 'source',
    Target = 'target', Value = 'value', NodeID = 'name',
    fontSize = 12, nodeWidth = 30))

```    
  </div>

  <div class="two-one">
<b>Obs. 4: ELA</b>   
```{r, fig.width=4, fig.height=3}
suppressMessages(sankeyNetwork(Links = sankeydat[[4]][[2]], Nodes = sankeydat[[4]][[1]], Source = 'source',
    Target = 'target', Value = 'value', NodeID = 'name',
    fontSize = 12, nodeWidth = 30))

```    
  </div>

  <div class="two-two">
<b>Obs. 5: Math</b> 
```{r, fig.width=4, fig.height=3}
suppressMessages(sankeyNetwork(Links = sankeydat[[5]][[2]], Nodes = sankeydat[[5]][[1]], Source = 'source',
    Target = 'target', Value = 'value', NodeID = 'name',
    fontSize = 12, nodeWidth = 30))

```  
  </div>
`r sankey`
</div>

</br></br>

# Linked Brushing Scatterplot Matrix

<div>
```{r, fig.width = 7}
scatdat <- mat %>%
    qdapTools::matrix2df('Observation') %>%
    mutate(
        Person = gsub(': .+$', '', Observation), 
        Observation = paste0("Obs. ", gsub('^[^:]+: ', '', Observation))
    )

scatdat[-c(1, 17)] <- lapply(scatdat[-c(1, 17)], round, 3)
scatterMatrix(
   data = scatdat, 6, 6
)
```
</div>

</br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br></br>

<p></p>

`r scatty`

</br></br>