如何解决闪亮：R 会话在对数据进行子集化时中止
我创建了一个 R 闪亮的应用程序，它为调查的开放式回复创建了一个词云。这是一个更大的闪亮仪表板的一部分，用于分析一系列大型调查。对于一项特定调查，在选择选项时（从“要查看的任期状态：”下拉菜单中），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,and service activities?")',fluidRow(
Box(title=OElist[1],width=12,status="primary",# 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"
),# 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],plotOutput("Strategies"),plotOutput("Strategies_FreqGraph"),searchInput(
inputId= "Stratsearch",# verbatimtextoutput(outputId = "Strategies_Search"),htmlOutput("Strategies_Search"),downloadBttn("Strategies_Data",#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,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,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,stopwords("english"))
ChallengesCorpus <- tm_map(ChallengesCorpus,removePunctuation)
ChallengesCorpus <- tm_map(ChallengesCorpus,stripwhitespace)
dtm=TermDocumentMatrix(ChallengesCorpus)
m=as.matrix(dtm)
v=sort(rowSums(m),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,stopwords("english"))
StrategiesCorpus <- tm_map(StrategiesCorpus,removePunctuation)
StrategiesCorpus <- tm_map(StrategiesCorpus,stripwhitespace)
dtm=TermDocumentMatrix(StrategiesCorpus)
m=as.matrix(dtm)
v=sort(rowSums(m),freq=v)
if(nrow(d)!=0){
Strategies=wordcloud(words = d$word,"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,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",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,row.names = FALSE)
}
)
})
shinyApp(ui,server)
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。