# Mastering Shiny — 4.8 Exercise 1: Next and Back Button

Below is the 4th exercise in book Mastering Shiny, Chapter 4: Case study: ER injuries.

“Provide a way to step through every narrative systematically with forward and backward buttons.Advanced: Make the list of narratives “circular” so that advancing forward from the last narrative takes you to the first.”

Collin Berke provided a solution, where the `%%` was used for the circular purpose. However, employing `%% `is a little tricky in this exercise. Thus, I use `if else` in both Next and Previous arrows. Here is the code.

``````library(shiny)
library(ggplot2)
library(vroom)
library(tidyverse)

# set your own directory
setwd('../../../data')

injuries <- vroom::vroom("neiss/injuries.tsv.gz")

population <- vroom::vroom("neiss/population.tsv")

products <- vroom::vroom("neiss/products.tsv")

prod_codes <- setNames(products\$prod_code, products\$title)

count_top <- function(df, var, n = 5) {
df %>%
mutate({{ var }} := fct_lump(fct_infreq({{ var }}), n = n)) %>%
group_by({{ var }}) %>%
summarise(n = as.integer(sum(weight)))
}

ui <- fluidPage(
fluidRow(
column(8,
selectInput("code", "Product",
choices = setNames(products\$prod_code, products\$title),
width = "100%"
)
),
column(2, selectInput("y", "Y axis", c("rate", "count"))),
column(2, numericInput("num_row", "Number of rows", 5, min = 1, max = 15))
),
fluidRow(
column(4, tableOutput("diag")),
column(4, tableOutput("body_part")),
column(4, tableOutput("location"))
),
fluidRow(
column(12, plotOutput("age_sex")),

),
fluidRow(
column(2, span("Narrative Display:", style = "font-weight: bold")),
column(1, actionButton(inputId ="Previous", label = icon("arrow-left"))),
column(1, actionButton(inputId ="Next", label = icon("arrow-right"))),
column(8, textOutput("narrative"))
)

)

server <- function(input, output, session) {

# use the last 6 records to test narrative
selected <- reactive(injuries %>% filter(prod_code == input\$code) %>% slice_tail(n=6))

n_row <- reactive(input\$num_row) # number of rows displayed in tables

output\$diag <- renderTable(count_top(selected(), diag, n = n_row()), width = "100%")
output\$body_part <- renderTable(count_top(selected(), body_part, n = n_row()), width = "100%")
output\$location <- renderTable(count_top(selected(), location, n = n_row()), width = "100%")

summary <- reactive({
selected() %>%
count(age, sex, wt = weight) %>%
left_join(population, by = c("age", "sex")) %>%
mutate(rate = n / population * 1e4)
})

output\$age_sex <- renderPlot({
if (input\$y == "count") {
summary() %>%
ggplot(aes(age, n, colour = sex)) +
geom_line() +
labs(y = "Estimated number of injuries")
} else {
summary() %>%
ggplot(aes(age, rate, colour = sex)) +
geom_line(na.rm = TRUE) +
labs(y = "Injuries per 10,000 people")
}
}, res = 96)

### narrative
num_narr <- reactive(
length(selected()\$narrative)
)

# a reactive value that can be easily changed later (in events)
# ref: https://stackoverflow.com/questions/42183161/r-shiny-how-to-change-values-in-a-reactivevalues-object
i <- reactiveValues(tmp=1)

# reset i to 1 if code is changed by user
# ref: https://www.collinberke.com/post/shiny-series-implementing-a-next-and-back-button/
observeEvent(input\$code, {
i\$tmp <- 1
})

output\$narrative <- renderText({
selected()\$narrative[1]
})

observeEvent(input\$Next, {

i\$tmp <- i\$tmp + 1

if(i\$tmp <= num_narr()){
output\$narrative <- renderText({
selected()\$narrative[i\$tmp]
})
} else{
i\$tmp <- 1
output\$narrative <- renderText({
selected()\$narrative[1]
})
}
})

observeEvent(input\$Previous, {
i\$tmp <- i\$tmp - 1

if(i\$tmp > 0){
output\$narrative <- renderText({
selected()\$narrative[i\$tmp]
})
} else{
i\$tmp <- num_narr()
output\$narrative <- renderText({
selected()\$narrative[num_narr()]
})
}
})

}

shinyApp(ui, server)``````

# R Package GrpString v.0.3.2 Released

`install.packages(“GrpString”)`
`library(GrpString)`

# transferring installed packages to a different installation of R

A user suggested that the loop isn’t necessary. Simply do

install.packages(installedpackages)

It used to take me a while to reinstall all the R packages that I use after upgrading to a new version of R.  I couldn’t think of another way to do this than to create a list of installed packages by examining the R package directory, and to manually select and install each one of those packages in the new version of R.  In order to ensure that my home and office installation of R had the same packages installed, I did something similar.

I recently discovered that there is a much, much easier way to transfer the packages that you have installed to a different installation of R.  I found some R code on the web that I adapted to my needs.  Here is what you need to do:

1. Run the script “store_packages.R” in your current version of R.

``# store_packages.R # # stores a list of…``

View original post 167 more words

# Package GrpString on CRAN

The R package GrpString is originally developed for analyzing and comparing groups of scanpaths in eye-tracking studies. However, it is ideal for string analysis in general, especially for quantifying differences between two groups of strings. Here is the flow chart showing most functions in the current version (0.3.1).

Some examples:

###### # Statistical difference between two groups of strings: strs1.vec <- c(“ABCDdefABCDa”, “def123DC”, “123aABCD”, “ACD13”, “AC1ABC”, “3123fe”) strs2.vec <- c(“xYZdkfAxDa”, “ef1563xy”, “BC9Dzy35X”, “AkeC1fxz”, “65CyAdC”, “Dfy3f69k”) ld.dif.vec <- StrDif(strs1.vec, strs2.vec, num_perm = 500, p.x = 0.025)

The package is available for download and install on CRAN, and you can find the latest version on GitHub.

# Using R to Read Eye-tracking Files (.txt, .tsv, ect.) and Organize Data

If a researcher is interested in certain time periods of an eye-tracking recording, such as problem-solving phases in education studies, he/she can replay the recording, generate segments or scenes, and then export the relevant data. However, this process is time-consuming. Using R may provide a way to quickly obtain and organize such data (when the definitions of time periods are clear). Here I use the text files exported by Tobii Studio as an example.
Suppose there are 15 .tsv files (which can be considered as .txt files) in a local folder “D:\tsv-aoi”. Each file contains the recording of a participant in an eye-tracking experiment.

The first step is to get all the 15 file names:

###### setwd(“D:/txt-aoi/”)filenames <- list.files(full.names=TRUE)

Each file looks like:

If we plan to obtain information between the first AOI11_1 (Timesamp=306913 in the above file) and the first AOI11_1 coming back (Timesamp=319356 in the above file), the next step is to read all 15 files into (a list of) data frames (notice the first 11 lines in each file are not needed), get the “Timestamp” and “AoiNames” columns for AOI11’s only.

###### aoiFiles <- lapply(filenames, function(x){                      read.table(x, header=TRUE,  sep=”\t”, skip=11) })aoiFiles_q11 <- lapply(aoiFiles, function(x){                               x[grep(“tor11.html”, x\$StimuliName), c(1,4)]})aoiFiles_q11

The result (showing from one of the 15 files):

We may remove consecutive duplicate AOIs from each data frame:

###### RmRepeat <- function(df, n){   X <- rle(as.character(df[,n]))   Y <- cumsum(c(1, X\$lengths[-length(X\$lengths)]))   return(df[Y,])}aoiFiles_q11rd <- lapply(aoiFiles, function(x) RmRepeat(x, 2))aoiFiles_q11rd

The final result (one of the 15) is shown below. From there we can analyze eye-tracking measures such as fixation duration and scanpath between the 2 red time stamps.