Dutch modality exclusivity norms (Bernabeu et al., 2017)
Authors: Pablo Bernabeu
Working with Shiny for 1+ years
Abstract: This app presents linguistic data over several tabs. The code combines the great front-end of Flexdashboard—based on R Markdown and yielding an unmatched user interface—, with the great back-end of Shiny—allowing users to download sections of data they select, in various formats. The hardest nuts to crack included modifying the rows/columns orientation without affecting the functionality of tables. A cool, recent finding was the reactable package. A nice feature, allowed by Flexdashboard, was the use of quite different formats in different tabs.
Full Description: This Flexdashboard-Shiny app presents linguistic data over several tabs. The code combines the great front-end of Flexdashboard—based on R Markdown and yielding an unmatched user interface—, with the great back-end of Shiny—allowing users to download sections of data they select, in various formats.
-
A cool, recent finding was the
reactablepackage, which puts Javascript into the cells, allowing coloured bars, etc.Auditory = colDef(header = with_tooltip('Auditory Rating', 'Mean rating of each word on the auditory modality across participants.'), cell = function(value) { width <- paste0(value / max(table_data$Auditory) * 100, "%") value = sprintf("%.2f", round(value,2)) # Round to two digits, keeping trailing zeros bar_chart(value, width = width, fill = '#ff3030') }, align = 'left'), -
One of the hardest nuts to crack was allowing the full functionality of tables—i.e, scaling to screen, frozen header, and vertical and horizontal scrolling—whilst having tweaked the vertical/horizontal orientation of the dashboard sections. Initial clashes were sorted by adjusting the section's CSS styles
Table {#table style="background-color:#FCFCFC;"} ======================================================================= Inputs {.sidebar style='position:fixed; padding-top: 65px; padding-bottom:30px;'} -----------------------------------------------------------------------and by also adjusting the
reactablesettings.renderReactable({ reactable(selected_words(), defaultSorted = list(cat = 'desc', word = 'asc'), defaultColDef = colDef(footerStyle = list(fontWeight = "bold")), height = 840, striped = TRUE, pagination = FALSE, highlight = TRUE, -
A nice feature, especially suited to Flexdashboard, was the use of different formats across tabs. Whereas the Info tab presents long text using HTML and CSS styling, along with
rmarkdowncode output, the other tabs rely more strongly on Javascript features, enabled by R packages such as ‘shiny’ andsweetalert(e.g., allowing modal dialogs—pop-ups),reactableandplotly(e.g., allowing information opened by hovering—tooltips).```{r} # reactive for the word bar highlighted_properties = reactive(input$highlighted_properties) renderPlotly({ ggplotly( ggplot( selected_props(), aes(RC1, RC2, label = as.character(word), color = main, # Html tags below used for format. Decimals rounded to two. text = paste0(' ', '<span style="padding-top:3px; padding-bottom:3px; font-size:2.2em; color:#EEEEEE">', capitalize(word), '</span> ', '<br>', '</b><br><span style="color:#EEEEEE"> Dominant modality: </span><b style="color:#EEEEEE">', main, ' ', ' ', '</b><br><span style="color:#EEEEEE"> Modality exclusivity: </span><b style="color:#EEEEEE">', sprintf("%.2f", round(Exclusivity, 2)), '% ', '</b><br><span style="color:#EEEEEE"> Perceptual strength: </span><b style="color:#EEEEEE">', sprintf("%.2f", round(Perceptualstrength, 2)), '</b><br><span style="color:#EEEEEE"> Auditory rating: </span><b style="color:#EEEEEE">', sprintf("%.2f", round(Auditory, 2)), ' ', '</b><br><span style="color:#EEEEEE"> Haptic rating: </span><b style="color:#EEEEEE">', sprintf("%.2f", round(Haptic, 2)), ' ', '</b><br><span style="color:#EEEEEE"> Visual rating: </span><b style="color:#EEEEEE">', sprintf("%.2f", round(Visual, 2)), ' ', '</b><br><span style="color:#EEEEEE"> Concreteness (Brysbaert et al., 2014): </span><b style="color:#EEEEEE">', sprintf("%.2f", round(concrete_Brysbaertetal2014, 2)), ' ', '</b><br><span style="color:#EEEEEE"> Number of letters: </span><b style="color:#EEEEEE">', letters, ' ', '</b><br><span style="color:#EEEEEE"> Number of phonemes (DutchPOND): </span><b style="color:#EEEEEE">', round(phonemes_DUTCHPOND, 2), ' ', '</b><br><span style="color:#EEEEEE"> Contextual diversity (lg10CD SUBTLEX-NL): </span><b style="color:#EEEEEE">', sprintf("%.2f", round(freq_lg10CD_SUBTLEXNL, 2)), ' ', '</b><br><span style="color:#EEEEEE"> Word frequency (lg10WF SUBTLEX-NL): </span><b style="color:#EEEEEE">', sprintf("%.2f", round(freq_lg10WF_SUBTLEXNL, 2)), ' ', '</b><br><span style="color:#EEEEEE"> Lemma frequency (CELEX): </span><b style="color:#EEEEEE">', sprintf("%.2f", round(freq_CELEX_lem, 2)), ' ', '</b><br><span style="color:#EEEEEE"> Phonological neighbourhood size (DutchPOND): </span><b style="color:#EEEEEE">', round(phon_neighbours_DUTCHPOND, 2), ' ', '</b><br><span style="color:#EEEEEE"> Orthographic neighbourhood size (DutchPOND): </span><b style="color:#EEEEEE">', round(orth_neighbours_DUTCHPOND, 2), ' ', '</b><br><span style="color:#EEEEEE"> Age of acquisition (Brysbaert et al., 2014): </span><b style="color:#EEEEEE">', sprintf("%.2f", round(AoA_Brysbaertetal2014, 2)), ' ', '<br> ' ) ) ) + geom_text(size = ifelse(selected_props()$word %in% highlighted_properties(), 7, ifelse(is.null(highlighted_properties()), 3, 2.8)), fontface = ifelse(selected_props()$word %in% highlighted_properties(), 'bold', 'plain')) + geom_point(alpha = 0) + # This geom_point helps to colour the tooltip according to the dominant modality scale_colour_manual(values = colours, drop = FALSE) + theme_bw() + ggtitle('Property words') + labs(x = 'Varimax-rotated Principal Component 1', y = 'Varimax-rotated Principal Component 2') + guides(color = guide_legend(title = 'Main<br>modality')) + theme( plot.background = element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.border = element_blank(), axis.line = element_line(color = 'black'), plot.title = element_text(size = 14, hjust = .5), axis.title.x = element_text(colour = 'black', size = 12, margin = margin(15,15,0,15)), axis.title.y = element_text(colour = 'black', size = 12, margin = margin(0,15,15,5)), axis.text.x = element_text(size = 8), axis.text.y = element_text(size = 8), legend.background = element_rect(size = 2), legend.position = 'none', legend.title = element_blank(), legend.text = element_text(colour = colours, size = 13) ), tooltip = 'text' ) }) # For download, save plot without the interactive 'plotly' part properties_png = reactive({ ggplot(selected_props(), aes(RC1, RC2, color = main, label = as.character(word))) + geom_text(show.legend = FALSE, size = ifelse(selected_props()$word %in% highlighted_properties(), 7, ifelse(is.null(highlighted_properties()), 3, 2.8)), fontface = ifelse(selected_props()$word %in% highlighted_properties(), 'bold', 'plain')) + geom_point(alpha = 0) + scale_colour_manual(values = colours, drop = FALSE) + theme_bw() + guides(color = guide_legend(title = 'Main<br>modality', override.aes = list(size = 7, alpha = 1))) + ggtitle( paste0('Properties', ' (showing ', nrow(selected_props()), ' out of ', nrow(props), ')') ) + labs(x = 'Varimax-rotated Principal Component 1', y = 'Varimax-rotated Principal Component 2') + theme( plot.background = element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.border = element_blank(), axis.line = element_line(color = 'black'), plot.title = element_text(size = 17, hjust = .5, margin = margin(3,3,7,3)), axis.title.x = element_text(colour = 'black', size = 12, margin = margin(10,10,2,10)), axis.title.y = element_text(colour = 'black', size = 12, margin = margin(10,10,10,5)), axis.text.x = element_text(size = 8), axis.text.y = element_text(size = 8), legend.background = element_rect(size = 2), legend.position = 'right', legend.title = element_blank(), legend.text = element_text(size = 15)) }) ```The only instance in which I drew on javascript code outside R packages was to enable tooltips beyond the packages’ limits—for instance, in the side bar. This javascript feature is created at the top of the script, in the
headarea.<!-- Javascript function to enable a hovering tooltip --> <script> $(document).ready(function(){ $('[data-toggle="tooltip1"]').tooltip(); }); </script> -
In the side bar, I added a reactive mean for each variable, complementing the range selector.
reactive(cat(paste0('Mean = ', sprintf("%.2f", round(mean(selected_words()$Exclusivity),2)))))
Non-Shiny version published in RPubs
A reduced, non-Shiny version was also created to increase the availability of the content. Removing Shiny features allows publication as a simple website. To create the Flexdashboard-only version departing from the Flexdashboard-Shiny version, I added a setting in the header of the script
knit: (function(inputFile, encoding) {
rmarkdown::render(inputFile, encoding = encoding) })
and disabled reactive features.
```{r}
# Number of words selected on sidebar
# reactive(cat(paste0('Words selected below: ', nrow(selected_props()))))
```
Category: Research
Keywords: science, cognition, language, linguistics, modality, stimulus, experiment, norming
Shiny app: https://pablobernabeu.shinyapps.io/dutch-modality-exclusivity-norms/
Repo: Dutch-modality-exclusivity-norms-Bernabeu-2018/Shiny-app at master · pablobernabeu/Dutch-modality-exclusivity-norms-Bernabeu-2018 · GitHub
RStudio Cloud: Posit Cloud
Thumbnail:
Full image:
