#r #shiny #selectinput
Вопрос:
Я создал приложение R shiny, которое создает облако слов для открытых ответов на опрос. Это часть более крупной блестящей панели мониторинга для анализа серии крупных опросов. Для одного конкретного опроса при выборе параметров (из раскрывающегося меню «Статус владения для просмотра:») R завершает работу с уведомлением «Сеанс R прерван». У меня был этот код, работающий для других наборов данных. Я попробовал этот точный код с другими наборами данных, и он работал так, как задумывалось. Примечание: предоставленный набор данных не является фактическим набором данных, который я намерен использовать в этом проекте (что добавляет некоторые сложности, поскольку я думаю, что набор данных может быть частью проблемы). Этот набор данных содержит конфиденциальную информацию, и им нельзя делиться. Набор данных, который я предоставляю, был создан так, чтобы выглядеть как набор данных, который я использую, и демонстрирует ту же проблему.
Данные: 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)
Комментарии:
1. Я не могу воспроизвести ошибку с этими данными и кодом. Выбранные параметры ничего не меняют на панелях просмотра, но сбоя нет. (В Ubuntu с R 4.0.5). Вы должны публиковать результаты
sessionInfo().2. Я нахожусь далеко от своего компьютера, поэтому я не могу попробовать это, но сделаю это, как только смогу. Меня беспокоит то, что я думаю, что я попробовал это, и, поскольку R выходит из строя во время работы приложения, результаты sessionInfo() выводят информацию о новом сеансе R. Можно ли распечатать это во время работы приложения shiny? Было бы полезно включить его в само приложение?
3. Вы должны быть в состоянии запустить
sessionInfo(), прежде чем запускать приложение shiny. Как правило, авторам пакетов сообщается об истинных сбоях консоли, поскольку это никогда не должно быть приемлемым режимом сбоя. Вас также попросят убедиться, что у вас самая последняя версия всех пакетов.