Переглянути джерело

Final step: use the typingStats() module to bootstrap into a fun app.

shiny-input
Garrick Aden-Buie 6 роки тому
джерело
коміт
d6fa10cb80
3 змінених файлів з 195 додано та 26 видалено
  1. +13
    -20
      inst/shiny-input-app/app.R
  2. +76
    -6
      inst/shiny-input-app/dev-shiny-input.Rmd
  3. +106
    -0
      inst/shiny-input-app/module_typingStats.R

+ 13
- 20
inst/shiny-input-app/app.R Переглянути файл



options(scipen = 1e3) options(scipen = 1e3)


typingSpeedInput <- function(inputId, label, placeholder = NULL) {
source("module_typingStats.R")

typingSpeedInput <- function(inputId, label, placeholder = NULL, rows = 4) {
.label <- label .label <- label
htmltools::withTags( htmltools::withTags(
div( div(
class = "form-group typing-speed", class = "form-group typing-speed",
label(class = "control-label", `for` = inputId, .label), label(class = "control-label", `for` = inputId, .label),
textarea(id = inputId, class = "form-control", placeholder = placeholder),
textarea(id = inputId, class = "form-control", placeholder = placeholder,
rows = rows),
htmltools::htmlDependency( htmltools::htmlDependency(
name = "typingSpeed", name = "typingSpeed",
version = "0.0.1", version = "0.0.1",
} }


ui <- fluidPage( ui <- fluidPage(
# textAreaInput("typing", "Type here..."),
typingStatsUI('typing_stats'),
typingSpeedInput("typing", "Type here..."), typingSpeedInput("typing", "Type here..."),
actionButton("reset", "Reset"), actionButton("reset", "Reset"),
frappeCharts::frappeChartOutput("chart_typing_speed") frappeCharts::frappeChartOutput("chart_typing_speed")
resetTypingSpeed("typing") resetTypingSpeed("typing")
}) })


wpm <- reactiveValues(time = c(), wpm = c())

observeEvent(input$typing_reset, {
wpm$time <- c()
wpm$wpm <- c()
})

observeEvent(input$typing, {
req(input$typing)
wpm$time <- c(wpm$time, input$typing$time)
wpm$wpm <- c(wpm$wpm, input$typing$wpm)
})
wpm <- typingStats(
"typing_stats",
typing = reactive(input$typing),
typing_reset = reactive(input$typing_reset)
)


output$chart_typing_speed <- frappeCharts::renderFrappeChart({ output$chart_typing_speed <- frappeCharts::renderFrappeChart({
frappeCharts::frappeChart( frappeCharts::frappeChart(
) )
}) })


observeEvent(wpm$time, {
frappeCharts::updateFrappeChart(
inputId = "chart_typing_speed",
data = data.frame(time = wpm$time, wpm = wpm$wpm)
)
observeEvent(wpm()$time, {
frappeCharts::updateFrappeChart('chart_typing_speed', wpm())
}) })
} }



+ 76
- 6
inst/shiny-input-app/dev-shiny-input.Rmd Переглянути файл

[shiny-debounce]: https://shiny.rstudio.com/reference/shiny/latest/debounce.html [shiny-debounce]: https://shiny.rstudio.com/reference/shiny/latest/debounce.html
[updateText-shiny-input-binding]: https://github.com/rstudio/shiny/blob/a2a4e40821b9811a40e461f67e3622196d8aa726/srcjs/input_binding_text.js#L31-L41 [updateText-shiny-input-binding]: https://github.com/rstudio/shiny/blob/a2a4e40821b9811a40e461f67e3622196d8aa726/srcjs/input_binding_text.js#L31-L41
[checkboxInput-shiny-input-binding]: https://github.com/rstudio/shiny/blob/a2a4e40821b9811a40e461f67e3622196d8aa726/srcjs/input_binding_checkbox.js [checkboxInput-shiny-input-binding]: https://github.com/rstudio/shiny/blob/a2a4e40821b9811a40e461f67e3622196d8aa726/srcjs/input_binding_checkbox.js
[typing-stats-module-gist]: https://gist.github.com/gadenbuie/08546fd96b96fbf810f84ccdc7b69bcc
[stringdist]: https://github.com/markvanderloo/stringdist
[type-racer]: https://gadenbuie.shinyapps.io/type-racer/


```{r setup, include=FALSE} ```{r setup, include=FALSE}
knitr::opts_chunk$set(eval = FALSE) knitr::opts_chunk$set(eval = FALSE)
you can run the code below to install the package you can run the code below to install the package
in the state I hope it's in by the time we finish that section. in the state I hope it's in by the time we finish that section.


```r
```{r}
devtools::install_github("gadenbuie/js4shiny-frappeCharts@pkg") devtools::install_github("gadenbuie/js4shiny-frappeCharts@pkg")
``` ```


we're going to cache the `time` and `wpm` sent from the browser we're going to cache the `time` and `wpm` sent from the browser
in a `reactiveValues` object that we can coerce into a `data.frame`. in a `reactiveValues` object that we can coerce into a `data.frame`.


```r
```{r}
# server # server
wpm <- reactiveValues(time = c(), wpm = c()) wpm <- reactiveValues(time = c(), wpm = c())




We add the `frappeCharts` output to our UI We add the `frappeCharts` output to our UI


```r
```{r}
# ui # ui
frappeCharts::frappeChartOutput("chart_typing_speed") frappeCharts::frappeChartOutput("chart_typing_speed")
``` ```


and use the following settings to render the `wpm` in "real time" and use the following settings to render the `wpm` in "real time"


```r
```{r}
# server # server
output$chart_typing_speed <- frappeCharts::renderFrappeChart({ output$chart_typing_speed <- frappeCharts::renderFrappeChart({
frappeCharts::frappeChart( frappeCharts::frappeChart(


### Don't redraw: Use the update method we made for frappeCharts ### Don't redraw: Use the update method we made for frappeCharts


`r github_sha_link("8d519b645abb990df17843f36cc418591e238aca")`

Replace the initial `frappeChart()` with a simple placeholder. Replace the initial `frappeChart()` with a simple placeholder.


```r
```{r}
# server # server
output$chart_typing_speed <- frappeCharts::renderFrappeChart({ output$chart_typing_speed <- frappeCharts::renderFrappeChart({
frappeCharts::frappeChart( frappeCharts::frappeChart(


and use the `updateFrappeChart()` function to update the chart in place. and use the `updateFrappeChart()` function to update the chart in place.


```r
```{r}
observeEvent(wpm$time, { observeEvent(wpm$time, {
frappeCharts::updateFrappeChart( frappeCharts::updateFrappeChart(
inputId = "chart_typing_speed", inputId = "chart_typing_speed",
) )
}) })
``` ```

## Final Step: Make it fun

Download the [Shiny module I created][typing-stats-module-gist] for this project
into the directory with your `app.R` file.

```{r}
download.file(
"http://bit.ly/js4shiny-typing-stats-module",
"module_typingStats.R"
)
```

Then source this module at the start of your app.

```{r}
source("module_typingStats.R")
```

Add the module's UI to your UI above the typing area.

```{r}
# ui
typingStatsUI('typing_stats')
```

While you're in the UI area,
fix something I missed earlier.
With bootstrap,
you can [set the number of rows](https://getbootstrap.com/docs/3.3/css/#textarea)
in the `textarea`.
Add this argument to `typingSpeedInput` and set the default value to `4`.

Use the `typingStats()` module to calculate `wpm`.
Replace the `wpm` reactive values list and the two observers we had before
with the new `typingStats()` module.

```{r}
# server
wpm <- typingStats(
"typing_stats",
typing = reactive(input$typing),
typing_reset = reactive(input$typing_reset)
)
```

And finally, use the new `wpm()` reactive from the module
as the data for the `frappeChart` update.

```{r}
observeEvent(wpm()$time, {
frappeCharts::updateFrappeChart('chart_typing_speed', wpm())
})
```

If you don't have the [stringdist] package installed,
install it now to get some extra stats.

```{r}
install.packages("stringdist")
```

Push the app to <https://shinyapps.io>!

Or check out the one I deployed: [type-racer].

+ 106
- 0
inst/shiny-input-app/module_typingStats.R Переглянути файл

typingStatsUI <- function(id) {
ns <- NS(id)
tagList(
fluidRow(
div(
class = "col-xs-12 col-sm-9 col-md-6",
uiOutput(ns("prompt"))
),
div(
class = "col-xs-12 col-sm-3 col-md-6",
style = "min-height: 75px;",
uiOutput(ns("wpm"))
)
)
)
}

typingStats <- function(id, typing, typing_reset = reactive(NULL), n_prompt = 4) {
callModule(typingStats_module, id, typing = typing, typing_reset = typing_reset)
}

date_now <- function() as.integer(Sys.time()) * 1000

typingStats_module <- function(
input,
output,
session,
typing,
typing_reset = reactive(NULL),
n_prompt = 4
) {
ns <- session$ns

wpm <- reactiveValues(time = date_now(), wpm = 0)

reactive_df <- function(x) {
as.data.frame(reactiveValuesToList(x))
}

observeEvent(typing_reset(), {
wpm$time <- date_now()
wpm$wpm <- 0
})

observeEvent(typing()$time, {
wpm$time <- c(wpm$time, typing()$time)
wpm$wpm <- c(wpm$wpm, typing()$wpm)
})

prompt <- reactive({
typing_reset()
sample(stringr::sentences, n_prompt)
})

output$prompt <- renderUI({
tags$blockquote(lapply(prompt(), tags$p))
})

has_stringdist <- requireNamespace("stringdist", quietly = TRUE)
if (!has_stringdist) {
warning(
"Install `stringdist` to get typing errors: install.packages('stringdist')",
immediate. = TRUE, call. = FALSE
)
}

output$wpm <- renderUI({
req(typing()$wpm)
wpm_class <- paste(
"wpm",
if (typing()$wpm < 40) {
"text-danger"
} else if (typing()$wpm < 75) {
"text-warning"
} else {
"text-success"
}
)
tagList(
div(
class = if (!has_stringdist) "col-xs-12" else "col-xs-6 col-sm-12",
tags$h2(
class = wpm_class,
round(typing()$wpm, 2), "wpm"
)
),
if (has_stringdist) div(
class = "col-xs-6 col-sm-12",
tags$h2(
class = "errors",
stringdist::stringdist(
substring(
paste(prompt(), collapse = "\n"),
1,
nchar(typing()$text)
),
typing()$text
),
"errors"
)
)
)
})

return(reactive(reactive_df(wpm)))
}

Завантаження…
Відмінити
Зберегти