блестящая панель: выберите входной фрейм данных - PullRequest
0 голосов
/ 23 сентября 2019

Добрый день, я использую блестящий пакет для панели инструментов, где я хотел бы отобразить четыре вывода и проанализировать различные кадры данных.Я вставил функцию выбора ввода в скрипт "ui".В «сервер» вместо этого я вставил функцию переключателя.Фреймы данных содержат тексты, которые должны быть предварительно обработаны.В заключение скрипт не запускается и не возвращает желаемых результатов.Я новичок, не могли бы вы мне помочь?В приложении я отправляю вам сценарий панели инструментов и данных.спасибо за ваше внимание.

Это пример данных:

df1=as.data.frame(cbind(userid=c(1:10), created_at=c(seq(as.Date("2000/1/1"),by= "month", length.out = 10)), text= c("Abuso sessuale e aggravante dell’uso di sostanze alcoliche", 
                                                                                                                 "Per chi non ricordasse, con l'attuale legge l'accusa di stupro si può avanzare solamente qualora si possa provare la presenza di violenza. Se la vittima reagisce in modo passivo, senza opporre evidente resistenza, non sussiste stupro, ma abuso sessuale. Insomma, un abominio.", 
                                                                                                                 "@BarbaraDeRossiO Al netto dei titoli sensazionalistici, la CdC ha evidenziato che c’è stata violenza sessuale di gruppo con abuso delle condizioni di inferiorità psichica o fisica.  Non ha detto non c’è stato stupro perché la vittima si era ubriacata o la colpa è tua perché avevi bevuto", 
                                                                                                                 "@FiorellaMannoia Cara Fiorella, cito da una mia amica:",
                                                                                                                 "In Manitoba, 6 women were killed",
                                                                                                                 "@FiorellaMannoia Cara Fiorella, cito da una mia amica:", 
                                                                                                                 "@PiovonoRoseNere @Giudo621 Non è così .. lo stupro è stato riconosciuto. non è stata riconosciuta l’aggravante dell’uso di sostanze alcoliche .. ma la violenza sessuale con l’aggravante dell’abuso di inferiorità psichica proprio perche era ubriaca è stato confermato.",
                                                                                                                 "#violenzasessusle #cassazione prima che vi scannia",
                                                                                                                 "@Manu_Erre_ Il punto che è un reato specifico, la ",
                                                                                                                 "Si sta scatenando un vortice insulso sulla sentenza")))
df2=as.data.frame(cbind(userid=c(1:7), created_at=c(seq(as.Date("2000/1/1"),by= "month", length.out = 7)), 
                    text= c("@DanielaPF75 @laura_lavespa @chiara84 Se ho ca", 
                            "@salvodimartino6 “violenza sessuale di gruppo con abuso condizioni di inferiorità psichica o fisica”anche se la vittima ha assunto alcol volontariamente, visto che“in uno stato in infermità psichica”a prescindere da chi l’abbia determinato,mancano le condizioni per prestare un valido consenso", 
                            "@1511maxi @MustErminea Ascoltami, per tua fortuna", 
                            "La Cassazione (sent. 32462 della III sez. penale) ha ",
                            "Dato che se parla ma nessuno spiega, no, non siamo",
                            "Il reato di violenza sessuale di gruppo con abuso de", 
                            "Quando sale la paura che nostro figlio autistico sia"
                    )))
df3=as.data.frame(cbind(userid=c(1:7), created_at=c(seq(as.Date("2000/1/1"),by= "month", length.out = 7)), 
                    text= c("Abuso sessuale e dinamiche familiari Spesso il luogo", 
                            "Abuso sessuale su una signora cinquantenne durante", 
                            "Ma come fatte a dire che la pedofilia è un orientameto", 
                            "Spagna, ragazza violentata da 5 persone. ",
                            "Carica di abuso sessuale di OSU mette in chiaro:",
                            "Perché non digiunate 10 giorni per ogni abuso sessua", 
                            "La Spagna introduce legge sul consenso esplicito"
                    )))

UI

datasets<<- list("first dataframe"="df1", 
             "second dataframe"="df2", 
             "third dataframe"="df3" 
             )

ui <- fluidPage(titlePanel("IULM Dashboard"), sidebarLayout(sidebarPanel(
selectInput("dataset", "Choose a Dataset:",
          choices = datasets)

),

 mainPanel( 
 plotOutput(outputId = "barplot", width = 600, height = 400),
 plotOutput(outputId = "network", width = 600, height = 600),
 plotOutput(outputId = "wordcloud", width = 600, height = 600),
 tableOutput(outputId = "latenttopics")
 )  
 )  
 )

SERVER

server <- function(input, output){

datasetInput <- reactive({
switch("first dataframe"= df1, 
       "second dataframe"= df2, 
       "third dataframe"= df3    )


input$dataset[3]=iconv(input$dataset[3], from = 'UTF-8', to = 'ASCII//TRANSLIT')
users <- input$dataset[1]
text <- input$dataset[3]
df_title <- data.frame(doc_id= row.names(users), Testo= text)
df_title <- remove_empty(df_title, which = "rows")

corpus <- Corpus(DataframeSource(df_title))
removeap <- function(x) gsub("'", " ", x)
removeNumPunct <- function(x) gsub("[^[:alpha:][:space:][:cntrl:][:alnum:][:blank:]?&/\\-]*", "", x)
removeURL <- function(x) gsub(" ?(f, ht)(tp)(s?)(://)(.*)[., /](.*)", "", x)
removeshorturl <- function(x) gsub("[goo.\\S+][@\\S+][ow.ly\\S+][ow.ly\\S+][bit.ly\\S+][fb.\\S+]
                                   [pic.\\S+][\\S+\\.it\\S+][\\S+\\.com\\S+]", "", x)
corpus=tm_map(corpus, content_transformer(removeap))
corpus=tm_map(corpus, content_transformer(removeURL))
corpus=tm_map(corpus, content_transformer(removeshorturl))
corpus=tm_map(corpus, content_transformer(removeNumPunct))
corpus=tm_map(corpus, removeWords, stopwords("it"))
ds0 <- tm_map(corpus,content_transformer(tolower))
ds1 <- tm_map(ds0,removeNumbers)
    dtm <- DocumentTermMatrix(ds, control = list(removePunctuation = TRUE, stopwords = "it", global = c(50,Inf)))
})

output$barplot <- renderPlot({

dtm1 = removeSparseTerms(dtm, 0.992)
freq <- colSums(as.matrix(dtm1))
wf = data.frame(term = names(freq), occurrences = freq)
wf <- wf[order(wf$occurrences, decreasing = TRUE),]
wf2 = subset(wf[1:10,]) 
ggplot(wf2, aes(term, occurrences)) +
  geom_bar(stat="identity", fill="darkred", colour="black", width=0.5)+
  theme(axis.text.x=element_text(angle=45, hjust=1))+
  ggtitle("Word barplot")
 })

output$network <- renderPlot({
dtm1 = removeSparseTerms(datasetInput, 0.992)
rowTotals <- apply(dtm1 , 1, sum) 
dtm2   <- dtm1[rowTotals> 0, ]
wdtm <- weightTf(dtm2)
dtm1 <- removeSparseTerms(wdtm, 0.96)
dfm <- as.dfm(dtm1)
textplot_network(dfm, min_freq = 0.5, omit_isolated = TRUE,
                 edge_color = "#1F78B4", edge_alpha = 0.5, edge_size = 2,
                 vertex_color = "#4D4D4D", vertex_size = 2,
                 vertex_labelsize = 5, offset = NULL)
})

output$wordcloud <- renderPlot({
dtm1 = removeSparseTerms(datasetInput, 0.992)
rowTotals <- apply(dtm1 , 1, sum) 
dtm2   <- dtm1[rowTotals> 0, ]
wdtm <- weightTf(dtm2)
freq <- colSums(as.matrix(wdtm))
wf = data.frame(term = names(freq), occurrences = freq)
wc <- as.matrix(weightTf(wf[1]))
wordcloud(wc, freq = wf$occurrences, max.words= 50, scale = c(10,1), random.color= TRUE,     random.order= FALSE, 
          rot.per= 0.35, colors= brewer.pal(8, "Dark2"))
 })



output$latenttopics <- renderTable({
burnin <- 4000
iter <- 2000
thin <- 500
seed <-list(2003,5,63,100001,765)
nstart <- 5
best <- TRUE
k <- 5
dtm1 = removeSparseTerms(datasetInput, 0.992)
rowTotals <- apply(dtm1 , 1, sum) 
dtm2   <- dtm1[rowTotals> 0, ]
ldaOut <- LDA(dtm2, k=k, method= "Gibbs")
ldaOut.terms.top10 <- as.data.frame(terms(ldaOut,10))
ldaOut.terms.top10}

)

}

shinyApp(ui = ui, server = server)
...