Wordcloud2 in shiny

wordcloud

#1

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


#2

Hi, I'm afraid I don't follow. Do you have a reproducible example you can show us?


#3

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"))
                
                
    )  
  ) 
))

#4

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:

  1. Click the little pencil icon at the bottom of your post to begin editing
  2. Select all the code
  3. Click the </> button at the top of the text entry box
  4. Save edits