I've created an R shiny app that creates a word cloud for open-ended responses from a survey. This is part of a larger shiny dashboard to analyze a series of large surveys. For one particular survey, when choosing options (from the "Tenure status to View:" drop-down menu), R crashes with the notice "R session aborted". I have had this code work for other data sets. I have tried this exact code with other datasets and it has worked as intended. Note: the data set provided isn't the actual data set I intend to use with this project (which adds some complications because I think the data set might be part of the problem). That dataset has sensitive information and could not be shared. The data set I am providing was created to look like the data set that I am using and is exhibiting the same problem.
The data: https://drive.google.com/file/d/1p5OZYbEr5rYNPL1TWoXa_zLNo4INO-4H/view?usp=sharing
library(sjmisc)
library(sjlabelled)
library(broom)
library(dplyr)
library(tidyr)
library(shiny)
library(shinyjs)
library(psych) # for describe and cronbach's alpha
library(scales)
library(ggplot2)
library(shinycssloaders)
library(shinydashboard)
library(haven)
library(expss)
library(openxlsx)
library(shinythemes)
library(DT)
library(shinyWidgets)
library(SnowballC)
library(wordcloud)
library(RColorBrewer)
library(tm)
sdata=read.xlsx("TestData.xlsx")
OEdata=sdata %>%
select(Tenure, Challenges, Strategies)
OEdata=expss::modify(OEdata, {
var_lab(Challenges)="What are the unique challenges of the COVID-19 pandemic that have impacted your research, teaching, and service activities?"
var_lab(Strategies)="Now that you have made changes to your teaching and research activities as a result of the pandemic, have you found strategies that worked so well that you plan to continue using them after the pandemic?"
})
OElist=vector()
OElist[1]=get_label(OEdata$Challenges)
OElist[2]=get_label(OEdata$Strategies)
TenureList =c("Tenure Status", levels(as.factor(OEdata$Tenure)))
OEdatasplit = list()
for (i in 1:length(TenureList)){
name = TenureList[i]
if (i==1){
OEdatasplit[[name]] = OEdata
OEdatasplit[[name]] = copy_labels(OEdatasplit[[name]] ,OEdata)
} else {
OEdatasplit[[name]] = OEdata %>% dplyr::filter(Tenure == name)
OEdatasplit[[name]] = copy_labels(OEdatasplit[[name]] ,OEdata)
}
}
ui=dashboardPage(
# skin defines color theme
skin="blue",
# title defines name of app
title="Faculty Experience Survey 2020",
# === === === === === === === === === === === === === === === === === === === === === === ==
#Header =============================================================================
dashboardHeader(
# information in header bar -- includes logo (image must be in www folder in app directory to work)
title=div(img(src="Illinois-Logo-Full-Color-RGB.png",
height="30",
style="margin-bottom:10px"),
"Faculty Experience Survey 2020",
# lock the title position
style="position: fixed; overflow: visible;"),
titleWidth=350
),
# === === === === === === === === === === === === === === === === === === === === === === ==
# Sidebar ============================================================================
dashboardSidebar(
# define fixed width for sidebar
width=350,
sidebarMenu(
# name sidebar for reference
id="sidebarmenu",
# lock the sidebar position
style="position: fixed; overflow: visible;",
# === === === === === === ===
# begin sidebar content =====
# FOR SBC, USER CHOOSES COHORT
# populates cohorts list from cohortlist in Global
selectInput(inputId="Tenure", label="Tenure status to View:", choices=TenureList,
selected="Tenure Status", multiple=FALSE, selectize=TRUE),
# sidebar menu items
# important to include unique tabName!
menuItem("Responses to Open-ended questions",
tabName="Write-ins", icon=icon("bar-chart")#,
)
)
),
# === === === === === === === === === === === === === === === === === === === === === === ==
# Dashboard body =====================================================================
dashboardBody(
# this code is placed internally to edit other visual features such as box colors
tags$style(HTML("
.box.box-solid.box-primary>.box-header {
color:#fff;
background:#888888
}
.box.box-solid.box-primary{
border-bottom-color:#888888;
border-left-color:#888888;
border-right-color:#888888;
border-top-color:#888888;
}
")),
# ===****===========================
# RESPONSES TO OPEN-ENDED QUESTIONS ====
tabItem(
tabName="Write-ins",
h2("Responses to Open-ended questions"),
h3("Figures will appear blank if there were no responsed to a question for a specified Cohort and Course"),
# SUPPORTING TABLES AND GRAPHS
br(),
fluidRow(
column(width=3,
box(title="Select Question(s) to View...",
background = "blue",
solidHeader=TRUE,width=NULL,
div(style="height: 400px; overflow-y: scroll;",
actionButton('all','Check All'),
actionButton('none','Uncheck All'),
checkboxGroupInput("WIList", label=NULL,
choices = OElist,
selected = OElist))
)) ,
#Challenges======================================================
column(width=9,
conditionalPanel(
condition = 'input.WIList.includes("What are the unique challenges of the COVID-19 pandemic that have impacted your research, teaching, and service activities?")',
fluidRow(
box(title=OElist[1],
width=12, status="primary", solidHeader=TRUE,
# dataTableOutput(test),
plotOutput("Challenges"),
plotOutput("Challenges_FreqGraph"),
br(),
searchInput(
inputId= "Csearch", label="Enter your text",
value = "Search Term",
placeholder = "Search Term",
btnSearch = icon("search"),
btnReset = icon("remove"),
width = "450px"
),
br(),
# verbatimTextOutput(outputId = "Challenges_Search"),
htmlOutput("Challenges_Search"),
downloadBttn('Challenges_Data', "Download Results")
)
)
),
#end ===
br()
),
#Strategies======================================================
column(width=9,
conditionalPanel(
condition = 'input.WIList.includes("Now that you have made changes to your teaching and research activities as a result of the pandemic, have you found strategies that worked so well that you plan to continue using them after the pandemic?")',
fluidRow(
box(title=OElist[2],
width=12, status="primary", solidHeader=TRUE,
# dataTableOutput(test),
plotOutput("Strategies"),
plotOutput("Strategies_FreqGraph"),
br(),
searchInput(
inputId= "Stratsearch", label="Enter your text",
value = "Search Term",
placeholder = "Search Term",
btnSearch = icon("search"),
btnReset = icon("remove"),
width = "450px"
),
br(),
# verbatimTextOutput(outputId = "Strategies_Search"),
htmlOutput("Strategies_Search"),
downloadBttn("Strategies_Data", "Download Results")
)
)
),
#end ===
br()
)
)
),
)
)
server=(function(input, output, session) {
# === === === === === === === === === === === === === === === === === === === === === =
# Add reactivity to the data ==========================================================
# this will split the data to render data only for the selected cohort(chosen using selectInput in the sidebarMenu)
OEReactive=reactive({
return(OEdatasplit[[input$Tenure]])
})
# =====****=================================================================================
###RESPONSES TO OPEN-ENDED QUESTIONS======================================================
#Create the checklist to control which questions appear==================================
#uncheck all
observeEvent(input$none,{
if (input$none > 0) {
updateCheckboxGroupInput(session=session, inputId="WIList", choices=OElist, selected=NULL)
}
})
# check all
observeEvent(input$all,{
if (input$all > 0) {
updateCheckboxGroupInput(session=session, inputId="WIList", choices=OElist, selected=OElist)
}
})
# #Challenges===============================================
##Render plot object creates the wordcloud
output$Challenges= renderPlot({
##Subset on Vars
OpenEnds=OEReactive()
ChallengesFrame=data.frame(doc_id=1:length(OpenEnds$Challenges), text=OpenEnds$Challenges)
Challenges=DataframeSource(ChallengesFrame)
ChallengesCorpus=Corpus(Challenges)
##Clean data and add stop words
# Convert the text to lower case
ChallengesCorpus <- tm_map(ChallengesCorpus, content_transformer(tolower))
# Remove numbers
ChallengesCorpus <- tm_map(ChallengesCorpus, removeNumbers)
# Remove english common stopwords
ChallengesCorpus <- tm_map(ChallengesCorpus, removeWords, stopwords("english"))
# Remove your own stop word
# specify your stopwords as a character vector
# ChallengesCorpus <- tm_map(ChallengesCorpus, removeWords, c("like", "course"))
# Remove punctuations
ChallengesCorpus <- tm_map(ChallengesCorpus, removePunctuation)
# Eliminate extra white spaces
ChallengesCorpus <- tm_map(ChallengesCorpus, stripWhitespace)
# Text stemming
# ChallengesCorpus <- tm_map(ChallengesCorpus, stemDocument)
##Final prep of object for wordcloud
dtm=TermDocumentMatrix(ChallengesCorpus)
m=as.matrix(dtm)
v=sort(rowSums(m), decreasing = T)
d=data.frame(word=names(v), freq=v)
##Create and print the wordcloud
#Won't work if are not enough responses:
if(nrow(d)!=0){
Challenges=wordcloud(words = d$word, freq = d$freq, min.freq = 1,
max.words=200, random.order=FALSE, rot.per=0.35,
colors=brewer.pal(8, "Dark2"))
print(Challenges)
}
})
#
output$Challenges_FreqGraph=renderPlot({
OpenEnds=OEReactive()
#Repeat of the above
ChallengesFrame=data.frame(doc_id=1:length(OpenEnds$Challenges), text=OpenEnds$Challenges)
Challenges=DataframeSource(ChallengesFrame)
ChallengesCorpus=Corpus(Challenges)
ChallengesCorpus <- tm_map(ChallengesCorpus, content_transformer(tolower))
ChallengesCorpus <- tm_map(ChallengesCorpus, removeNumbers)
ChallengesCorpus <- tm_map(ChallengesCorpus, removeWords, stopwords("english"))
ChallengesCorpus <- tm_map(ChallengesCorpus, removePunctuation)
ChallengesCorpus <- tm_map(ChallengesCorpus, stripWhitespace)
dtm=TermDocumentMatrix(ChallengesCorpus)
m=as.matrix(dtm)
v=sort(rowSums(m), decreasing = T)
d=data.frame(word=names(v), freq=v)
topWords=head(d, 20)
if(nrow(d)!=0){
topWordsGraph=ggplot(topWords, aes(x=reorder(word, -freq), y=freq)) +geom_bar(stat = "identity", fill="#11294B")+
theme(axis.text.x = element_text(face = "bold", size = 12, angle = 45, hjust=1), panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
xlab("Examples of Frequently Used Words") +
ylab("Frequency")+
ggtitle(get_label(OpenEnds$Challenges))
print(topWordsGraph)
}
})
output$Challenges_Search=renderUI({
OpenEnds=OEReactive()
OpenEnds=as.data.frame(OpenEnds)
if(input$Csearch=="Search Term"| input$Csearch==""){
OEs=""
HTML(OEs)
} else{
Results=grep(input$Csearch, OpenEnds$Challenges)
ResultOEs=OpenEnds$Challenges[Results]
OEs=c()
for (i in 1:length(ResultOEs)) {
OEs[i]=paste(ResultOEs[i],"<br/> <br/>")
}
HTML(OEs)
}
})
output$Challenges_Data=downloadHandler(
#Code for download
filename = function(){
paste("Challenges", ".csv", sep = "")
},
content=function(file){
OpenEnds=OEReactive()
Results=grep(input$Csearch, OpenEnds$Challenges)
ResultOEs=OpenEnds$Challenges[Results]
ResultOEs=as.data.frame(ResultOEs)
colnames(ResultOEs)=get_label(OpenEnds$Challenges)
write.csv(ResultOEs, file, row.names = FALSE)
}
)
#Strategies====================================================
#Render plot object creates the wordcloud
output$Strategies= renderPlot({
##Subset on Vars
OpenEnds=OEReactive()
StrategiesFrame=data.frame(doc_id=1:length(OpenEnds$Strategies), text=OpenEnds$Strategies)
Strategies=DataframeSource(StrategiesFrame)
StrategiesCorpus=Corpus(Strategies)
StrategiesCorpus <- tm_map(StrategiesCorpus, content_transformer(tolower))
StrategiesCorpus <- tm_map(StrategiesCorpus, removeNumbers)
StrategiesCorpus <- tm_map(StrategiesCorpus, removeWords, stopwords("english"))
StrategiesCorpus <- tm_map(StrategiesCorpus, removePunctuation)
StrategiesCorpus <- tm_map(StrategiesCorpus, stripWhitespace)
dtm=TermDocumentMatrix(StrategiesCorpus)
m=as.matrix(dtm)
v=sort(rowSums(m), decreasing = T)
d=data.frame(word=names(v), freq=v)
if(nrow(d)!=0){
Strategies=wordcloud(words = d$word, freq = d$freq, min.freq = 1,
max.words=200, random.order=FALSE, rot.per=0.35,
colors=brewer.pal(8, "Dark2"))
print(Strategies)
}
})
output$Strategies_FreqGraph=renderPlot({
OpenEnds=OEReactive()
StrategiesFrame=data.frame(doc_id=1:length(OpenEnds$Strategies), text=OpenEnds$Strategies)
Strategies=DataframeSource(StrategiesFrame)
StrategiesCorpus=Corpus(Strategies)
StrategiesCorpus <- tm_map(StrategiesCorpus, content_transformer(tolower))
StrategiesCorpus <- tm_map(StrategiesCorpus, removeNumbers)
StrategiesCorpus <- tm_map(StrategiesCorpus, removeWords, stopwords("english"))
StrategiesCorpus <- tm_map(StrategiesCorpus, removePunctuation)
StrategiesCorpus <- tm_map(StrategiesCorpus, stripWhitespace)
dtm=TermDocumentMatrix(StrategiesCorpus)
m=as.matrix(dtm)
v=sort(rowSums(m), decreasing = T)
d=data.frame(word=names(v), freq=v)
topWords=head(d, 20)
if(nrow(d)!=0){
topWordsGraph=ggplot(topWords, aes(x=reorder(word, -freq), y=freq)) +geom_bar(stat = "identity", fill="#11294B")+
theme(axis.text.x = element_text(face = "bold", size = 12, angle = 45, hjust=1), panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black")) +
xlab("Top Twenty Most Frequent Words") +
ylab("Frequency")+
ggtitle(get_label(OpenEnds$Strategies))
print(topWordsGraph)
}
})
output$Strategies_Search=renderUI({
OpenEnds=OEReactive()
OpenEnds=as.data.frame(OpenEnds)
if(input$Stratsearch=="Search Term"| input$Stratsearch==""){
OEs=""
HTML(OEs)
} else{
Results=grep(input$Stratsearch, OpenEnds$Strategies)
ResultOEs=OpenEnds$Strategies[Results]
OEs=c()
for (i in 1:length(ResultOEs)) {
OEs[i]=paste(ResultOEs[i],"<br/> <br/>")
}
HTML(OEs)
}
})
output$Strategies_Data=downloadHandler(
#Code for download
filename = function(){
paste("Strategies", ".csv", sep = "")
},
content=function(file){
OpenEnds=OEReactive()
Results=grep(input$Stratsearch, OpenEnds$Strategies)
ResultOEs=OpenEnds$Strategies[Results]
ResultOEs=as.data.frame(ResultOEs)
colnames(ResultOEs)=get_label(OpenEnds$Strategies)
write.csv(ResultOEs, file, row.names = FALSE)
}
)
})
shinyApp(ui, server)