I am displaying wordcloud using wordcloud2 function. it is embedding words continuously. i am unable to identify completion of embedding words in word cloud even though i used withprogress function
Hi, I'm afraid I don't follow. Do you have a reproducible example you can show us?
Hi jcheng,
Find below code for reproducible example
shinyServer(function(input, output, session) {
# Define a reactive expression for the document term matrix
heade<-reactive({
file1 <- input$file
if(is.null(file1)) {return()}
type=unlist(strsplit(file1$name,".",fixed=T))[2]
if(type=='xlsx') {
file.rename(file1$datapath,
paste(file1$datapath, ".xlsx", sep=""))
z=excel_sheets(paste(file1$datapath, ".xlsx", sep=""))
}
else z=NULL
z
})
values2<-reactiveValues()
observe({
file3<-input$file2
if(is.null(file3)){return()}
type=unlist(strsplit(file3$name,".",fixed=T))[2]
values2$phrases=as.data.frame(read.csv(file3$datapath,stringsAsFactors = F,blank.lines.skip=T))
})
output$cloud<-renderUI({
if (is.null(input$max )| is.null(input$freq) | is.null(terms())){return()}
v1=terms()
maxi=nrow(v1[v1$freq>=input$freq,])
if(input$max<2500){wordcloud2Output("plot",width = "750px", height="750")}
else
{
x=ceiling(min(maxi,input$max)*0.4)
#n<-ceiling((input$max-250)*1000/input$max+750+(maxi-input$freq)*500/maxi)
wordcloud2Output("plot",width = paste0("",x,"px"), height=paste0("",x,""))
}
})
observeEvent(input$resetbut, {
reset("file1") # reset is a shinyjs function
values1$dictionary=NULL
})
observeEvent(input$resetwords, {
reset("file2") # reset is a shinyjs function
values2$phrases<-NULL
})
observeEvent(input$freq1,{
if(!is.null(input$freq1)& (input$freq!=as.numeric(input$freq1))){
val=as.numeric(input$freq1)
updateSliderInput(session,"freq",value=val)
}
})
observeEvent(input$freq,{
if(!is.null(input$freq) & (input$freq!=as.numeric(input$freq1))){
val=as.numeric(input$freq)
updateTextInput(session,"freq1",value=val)
}
})
observeEvent(input$max1,{
if(!is.null(input$max1)& (input$max!=as.numeric(input$max1))){
val=as.numeric(input$max1)
updateSliderInput(session,"max",value=val)
}
})
observeEvent(input$max,{
if(!is.null(input$max) & (input$max!=as.numeric(input$max1))){
val=as.numeric(input$max)
updateTextInput(session,"max1",value=val)
}
})
var<-reactive({
if(is.null(data())) {return()}
x=data()
names(x)
})
output$Variable<-renderUI({
if(is.null(var())) {return()}
selectInput("vari","Select the Variable Name",choices=var())
})
data<-reactive({
file1 <- input$file
if(is.null(file1)) {return()}
type=unlist(strsplit(file1$name,".",fixed=T))[2]
if(type=='xlsx')
{
file.rename(file1$datapath,
paste(file1$datapath, ".xlsx", sep=""))
read_excel(paste(file1$datapath, ".xlsx", sep=""),sheet=input$sheet)
}
else
if (type=='CSV')
{
# read.csv(file1$datapath,stringsAsFactors = T,blank.lines.skip=T)
fread(file1$datapath,sep=",",data.table = F)
}
else
{
read.delim(file1$datapath, comment.char="#",stringsAsFactors = F,blank.lines.skip=T)}
})
values1<-reactiveValues()
observe({
file2 <- input$file1
if(is.null(file2)) {return()}
type1=unlist(strsplit(file2$name,".",fixed=T))[2]
if (type1=='CSV')
{
values1$dictionary<- read.csv(file2$datapath,blank.lines.skip=T)
}
else
{
values1$dictionary<- read.delim(file2$datapath, comment.char="#",stringsAsFactors = F,blank.lines.skip=T)}
})
max1<-reactive({
if(is.null(input$max)){return()}
print(input$max)
input$max
})
terms2 <- reactive({
# Change when the "update" button is pressed...
if(is.null(terms()) | is.null(max1())|is.null(input$freq)){return()}
print(max1())
v=terms()
x2=v[v$freq>=input$freq,]
#x2<-dfm_trim(x1,min_count=input$freq)
n1=min(max1(),4000)
if(nrow(x2)>n1){
x3=x2[1:n1,]}
else
x3=x2
print(nrow(x3))
# x3<- dfm_keep(x2,names(topfeatures(x2,n=n1,decreasing = T,scheme=c('count'))))
#wordcloud(v3$word,freq=v3$freq,random.order=F,min.freq = 1)
names(x3)=c('name','value')
x3
})
terms <- reactive({
# Change when the "update" button is pressed...
if(is.null(terms1())){return()}
z=data.frame(word=featnames(terms1()),freq=colSums(terms1()))
z=z[order(-z$freq),]
z
})
terms1 <- reactive({
# Change when the "update" button is pressed...
input$update
forget(getTermMatrix)
# ...but not for anything else
isolate({
withProgress({
setProgress(message = "Processing corpus...")
t=data()
t1=values1$dictionary
if(is.null(t) ){return()}
if (is.null(t1))
{
getTermMatrix(t[,input$vari])
}
else
{
getTermMatrix(t[,input$vari],t1[,1])}
})
})
})
output$sheetname <-renderUI({
file1 <- input$file
if(is.null(file1) || unlist(strsplit(file1$name,".",fixed=T))[2]!='xlsx'){return()}
selectInput("sheet","Select the Sheet Name",choices=heade())
})
output$sliderfreq<-renderUI({
v1=terms()
if(is.null(v1)){return()}
minimum<-min(v1$freq)
maximum<-max(v1$freq)
fluidRow(
column(width=11,sliderInput("freq",label =
"Minimum Frequency:",
min = minimum, max = maximum, step=1,value = minimum+round((maximum-minimum)/4))),
column(width=10,textInput("freq1",label="",value=minimum+round((maximum-minimum)/4))))
})
output$Sliderword<-renderUI({
v1=terms()
if(is.null(v1)){return()}
x=nrow(v1)
if(x==0)
{stop("No words to display")}
x1=min(x,4000)
fluidRow(
column(width=11, sliderInput("max",
"Maximum Number of Words:", min = 1, max = x1, step=1, value = round((x1-1)/4))),
column(width=10,textInput("max1",label = "",value=round((x1-1)/4)))
)
})
wordcloud_rep <- repeatable(wordcloud2)
getTermMatrix <- memoise(function(book,dic=NULL) {
# Careful not to let just any name slip in here; a
# malicious user could manipulate this value.
#write.csv(book,'D:/book.csv')
# book<-book[!is.null(book),]
#myCorpus = Corpus(VectorSource(as.character(book)))
text=as.data.frame(book)
names(text)[1]='text'
# print(typeof(text$text))
mycorpus=corpus(as.character(text$text))
rm(list='text')
#x=texts(myCorpus) %>% char_tolower()%>%tokens()%>%tokens_remove(stopwords('english')) %>% tokens_remove(" ")
if(!is.null(values2$phrases) & input$stem=='y' )
{
x1=values2$phrases
x1$sentiment=tolower(trimws(x1[,1]))
names(x1)[1]='word'
x1$word=tolower(trimws(x1$word))
dtc=as.dictionary(x1)
#rm(list='x1')
#print(dtc)
z=dfm(tolower(mycorpus),dictionary = dtc)
rm(list='dtc')
#print(z)
txt<-dfm(mycorpus,tolower=T,remove=c(stopwords('english'),x1$word,tolower(dic)),stem=TRUE,remove_punct=TRUE,remove_numbers=TRUE,remove_symbols=TRUE,remove_url=TRUE,remove_twitter=TRUE,removeHyphens=T,removeSeparators = TRUE,ngrams= 1L)
rm(list='x1')
# print(txt)
m=cbind(txt,z)
rm(list=c('z','txt'))
}
else if(!is.null(values2$phrases))
{
x1=values2$phrases
x1$sentiment=tolower(trimws(x1[,1]))
names(x1)[1]='word'
x1$word=tolower(trimws(x1$word))
dtc=as.dictionary(x1)
#print(dtc)
z=dfm(tolower(text$text),dictionary = dtc)
rm(list='dtc')
txt<-dfm(mycorpus,tolower=T,remove=c(stopwords('english'),x1$word,tolower(dic)),remove_punct =TRUE,remove_numbers=TRUE,remove_symbols=TRUE,remove_url=TRUE,remove_twitter=TRUE,removeHyphens=T,removeSeparators = TRUE)
m=cbind(txt,z)
rm(list='x1')
rm(list=c('z','txt'))
}
else if(input$stem=='y')
{
m<-dfm(mycorpus,tolower=T,remove=c(stopwords('english'),tolower(dic)),stem=TRUE,remove_punct=TRUE,remove_numbers=TRUE,remove_symbols=TRUE,remove_url=TRUE,remove_twitter=TRUE,removeHyphens=T,removeSeparators = TRUE)
}
print('every')
m
})
output$plot<-renderWordcloud2({
v <- terms2()
wordcloud_rep(data=v,size = 1)
#textplot_wordcloud(x3,random_order=F,fixed_aspect=F,rotation=0,color=brewer.pal(8, "Dark2"),max_words=n1)
})
#if(!is.null(terms2())) {renderWordcloud('test',terms2()) }
# renderWordcloud('test',if(is.null(terms2())) {return()} else {data=terms2()})
})
shinyUI(pageWithSidebar(
# Application title
headerPanel("Text Mining"),
#sidebarLayout(
# Sidebar with a slider and selection inputs
div(id='side',sidebarPanel( useShinyjs(),
conditionalPanel(condition = "input.x ==10",tags$style(type = 'text/css',".well {background-color: white;border:none;}"),tags$img(src='text.jpg',align = "right",width='110%',height='200%')),
conditionalPanel(condition = "input.x ==1 |input.x ==2 |input.x==3",fileInput('file',"Choose File to load:",accept = c('.xlsx','.csv','.txt','.dat')),tags$script('$( "#file" ).on( "click", function() { this.value = null; });'),
fluidRow(column(width=8,fileInput("file1","Choose File for dictionary(optional):",accept = c('.csv','.txt','.dat'))),column(width=4,actionButton("resetbut","clear dict"))),tags$script('$( "#file1" ).on( "click", function() { this.value = null; });'),
fluidRow(column(width=8,fileInput("file2","Choose File for words together(optional):",accept = c('.csv'))),column(width=4,actionButton("resetwords","clear words"))),tags$script('$( "#file2" ).on( "click", function() { this.value = null; });'),
uiOutput("sheetname"), uiOutput('Variable'),radioButtons("stem",'Stemming Required',c('Yes'='y','No'='n')),actionButton("update", "Submit"),
hr(),
uiOutput('Sliderword'),uiOutput("sliderfreq"))
)), # Show Word Cloud
mainPanel(
tabsetPanel(id='x',
tabPanel("Home",value=10, tags$br(),tags$h1(tags$b('Purpose of App:'),style="color:blue;font-size: 16px"),tags$div(tags$p("This app helps to extract and understand distribution of tokens (words) of unstructured text after considering the below points",style="font-size: 14px")),tags$h2("Mandatory:",style="color:blue;font-size: 16px"),tags$ol(tags$li("Words are displayed in lowercase",style="font-size:14px"),tags$li("App will remove the default English stop words (Ex: A, An, The), punctuations and numbers",style="font-size:14px")),
tags$h2("Optional:",style="color:blue;font-size: 16px"),tags$ol(tags$li("App will remove user specified words provided in the dictionary",style="font-size:14px"),tags$li("App will provide distribution of phrases (To keep words together)",style="font-size:14px")),tags$br(),tags$div(tags$p('User can see more details in below url',style='font-size:14px')),tags$a("Refrence document URL",target="_blank",href="reference doc Text mining.pdf")),
tabPanel("Word Cloud",value=1,uiOutput('cloud'),downloadButton("downloadWordcloud", "Download")),
tabPanel("Word Frequency Bar Chart",value=2,plotlyOutput('Frequency',width = "1000px", height="1000px")),
tabPanel("Complete Data",value=3, DT::dataTableOutput("contents"),downloadButton("downloadData", "Download"))
)
)
))
1 Like
It’s difficult to read code that isn’t formatted as code (and making your post easier to read helps you get answers faster!). Here’s how to fix the formatting:
- Click the little pencil icon at the bottom of your post to begin editing
- Select all the code
- Click the
</>button at the top of the text entry box - Save edits
1 Like