Я пытаюсь применить функцию моделирования topi c ниже в приложении R Shiny и получить индикатор выполнения, пока на нем R. Я увидел кое-что, что, как мне показалось, могло бы пригодиться в этом задании, но я уверен, что просто не смог получить его, поэтому я набрал его так неправильно!
library(stringr)
library(text2vec)
library(shiny)
library(dplyr)
library(textstem)
library(LDAvis)
data <- structure(list(Abstract = c("With all this stuff going down at the moment with MJ i've started listening to his music, watching the odd documentary here and there, watched The Wiz and watched Moonwalker again. Maybe i just want to get a certain insight into this guy who i thought was really cool in the eighties just to maybe make up my mind whether he is guilty or innocent.",
" Obviously, everyone looks for different things in a movie. Those who envision themselves as amateur ",
"The film starts with a manager (Nicholas Bell) giving welcome investors (Robert Carradine) to Primal Park.",
"in which, by the way, the transcendant loveliness of nature is represented by a scattering of shopworn and flaccid crocuses stuck in ill-laid turf, an expedient which baffles me.",
"Superbly trashy and wondrously unpretentious 80's exploitation, hooray! The pre-credits opening sequences somewhat give the false impression that we're dealing with a serious and harrowing drama, but you need not fear because barely ten minutes later we're up until our necks in nonsensical chainsaw battles, rough fist-fights, lurid dialogs and gratuitous nudity!",
"I dont know why people think this is such a bad movie. Its got a pretty good plot, some good action, and the change of location for Harry does not hurt either. Sure some of its offensive and gratuitous but this is not the only movie like that.",
"This movie could have been very good, but comes up way short. Cheesy special effects and so-so acting. I could have looked past that if the story wasn't so lousy. I would avoid this movie.",
"I watched this video at a friend's house. I'm glad I did not waste money buying this one. The video cover has a scene from the 1975 movie Capricorn One.",
"A friend of mine bought this film for 1, and even then it was grossly overpriced. Despite featuring big names such as Adam Sandler, Billy Bob Thornton and the incredibly talented Burt Young, this film was about as funny as taking a chisel and hammering it straight through your earhole.",
" The ladybugs face its a clear reference (or tribute) to Peter Lorre. This movie is a masterpiece. Well talk much more about in the future.",
"What happens when an army of wetbacks, towelheads, and Godless Eastern European commies gather their forces south of the border? ",
" I didn't actually know so far until reading the previous comment that this was a remake, so my opinion is purely about the actual film and not a comparison.",
"<br /><br />While an expected boring school bus trip has only been used for comic purposes, such as on \\\"The Simpsons,\\\" this central situation of a visit to Salisbury Cathedral in Rhidian Brook's script is well-contained and structured for dramatic purposes, and is almost formally divided into acts.<br /><br />",
" I was right. He must be looking for champagne money, and not care about the final product... his voice gets repeatedly dubbed over by a stranger that sounds nothing like him; the editing is - well - just a grade above amateurish.",
"note to George Litman, and others: the Mystery Science Theater 3000 riff is \\\"I don't think so, *breeder*\\\you looking at his 'like'?\\\", simply for the complete absurdity. that, and \\\"Right well did not!\\\" over all",
"Stephen King adaptation (scripted by King himself) in which a young family, newcomers to rural Maine, find out about the pet cemetery close to their home.",
"`The Matrix' was an exciting summer blockbuster that was visually fantastic but also curiously thought provoking in its `Twilight Zone'-ish manner.",
"Ulli Lommel's 1980 film 'The Boogey Man' is no classic, but it's an above average low budget chiller that's worth a look. The sequel, 1983s 'Boogey Man II' is ultimately a waste of time, but at the very least it's an entertaining one if not taken the least bit seriously.",
"Some of its poignant scenes are filled with sublime emotional intensity, like the instance, when Meena Kumari refuses to say as an approval for Nikah (Marriage Bond) and climbs down the hill while running berserk in traumatized frenzy.",
"Most people, especially young people, may not understand this film. It looks like a story of loss, when it is actually a story about being alone. Some people may never feel loneliness at this level.",
"\\\"Soylent Green\\\" is one of the best and most disturbing science fiction movies of the 70's and still very persuasive even by today's standards. ",
"Michael Stearns plays Mike, a sexually frustrated individual with an interesting moral attitude towards sexuality. ",
"This happy-go-luck 1939 military swashbuckler, based rather loosely on Rudyard Kipling's memorable poem as well as his novel qualifies as first-rate entertainment about the British Imperial Army in India in the 1880s. ",
"I would love to have that two hours of my life back.",
"The script for this movie was probably found in a hair-ball recently coughed up by a really old dog. Mostly an amateur film with lame FX.",
"Looking for Quo Vadis at my local video store, I found this 1985 version that looked interesting. Wow! It was amazing! Very much a Ken Russell kind of film -quirky, stylized, very artistic, and of course. Nero was presented not so much as evil incarnate, but as a wacky, unfulfilled emperor who would rather have had a circus career. ",
"Note to all mad scientists everywhere: if you're going to turn your son into a genetically mutated monster, you need to give him a scarier name than care if he's a frightening hammerhead shark with a mouthful of dagger-sharp teeth and the ability to ambush people in the water as well as on dry land ",
"What the ........... is this ? This must, without a doubt, be the biggest waste of film, settings and camera ever. ",
"I hardly own every gay movie ever made, but I am comfortable in stating that I pretty much purchase almost every gay video of interest that gets released, and very often I buy videos without knowing anything about the film. ",
"Would anyone really watch this RUBBISH if it didn't contain little children running around nude? From a cinematic point of view it is probably one of the worst films I have encountered absolutely dire.",
"Unremarkable and unmemorable remake of an old, celebrated English film. Although it may be overly maligned as a total disaster (which it is not), it never builds any tension and betrays its TV origins. ",
"Simon Pegg plays a rude crude and often out of control celebrity journalist who is brought from England to work for a big American magazine. ",
"Faithful adaptation of witty and interesting French novel about a cynical and depressed middle-aged software engineer (or something), relying heavily on first-person narration but none the worse for that.",
"Eva (Hedy Lamarr) has just got married with an older man and in the honeymoon, she realizes that her husband does not desire her. ",
"Even if this film was allegedly a joke in response to critics it's still an awful film. If one is going to commit to that sort of thing at least make it a good joke.....first off, Jeroen Krabb is i guess the poor man's Gerard Depardieu.....",
"If you are looking for eye candy, you may enjoy Sky Captain. Sky Captain is just a video game injected with live performers. The visials are nice and interesting to look at during the entire movie.",
"Although at one point I thought this was going to turn into The Graduate, I have to say that The Mother does an excellent job of explaining the sexual desires of an older woman.<br /><br />I'm so glad this is a British film because Hollywood never would have done it, and even if they had, they would have ruined it by not taking the time to develop the characters.",
"Dumb is as dumb does, in this thoroughly uninteresting, supposed black comedy. Essentially what starts out as Chris Klein trying to maintain a low profile, eventually morphs into an uninspired version of \\\"The Three Amigos\\\", only without any laughs. In order for black comedy to work, it must be outrageous",
"I found this movie quite by accident, but am happy that I did. Kenneth Branagh's performance came close to stealing this movie from Helena Bonham Carter, but their strong chemistry together made for a much more enjoyable movie. This movie brought to mind the excellent movies that Branagh made with Emma Thompson.",
"I'll dispense with the usual comparisons to a certain legendary filmmaker known for his neurotic New Yorker persona, because quite frankly, to draw comparisons with bumbling loser Josh Kornbluth, is just an insult to any such director. I will also avoid mentioning the spot-on satire `Office Space' in the same breath as this celluloid catastrophe. ",
"At first sight this movie doesn't look like a particular great one. After all a Bette Davis movies with only 166 votes on IMDb and a rating of 6,5 must be a rather bad one. But the movie turned out to be a delightful and original surprise.<br /><br />",
"Well then, what is it?! I found Nicholson's character shallow and most unfortunately uninteresting. Angelica Huston's character drained my power.",
"Antonio Margheriti's \\\"Danza Macabra\\\"/\\\"Castle of Blood\\\" is an eerie,atmospheric chiller that succeeds on all fronts.It looks absolutely beautiful in black & white and it has wonderfully creepy Gothic vibe.",
"I don't know who Sue Kramer, the director of this film is, but I have a strong suspicion that A) she is a lesbian and B) she somehow shamed everyone involved in this project to participate to prove they are not homophobic.<br /><br />I can imagine everyone thinking, \\\"My God, this is horrible.",
"I just watched this movie on Starz. Let me go through a few things i thought could have been improved; the acting, writing, directing, special effects, camera crew, sound, and lighting. It also seemed as though the writers had no idea anything that had to do with the movie.",
"I loved the episode but seems to me there should have been some quick reference to the secretary getting punished for effectively being an accomplice after the fact. ",
"This film is a massive Yawn proving that Americans haven't got the hang of farce. Even when it has already been written for them! The original film",
"I was at the same screenwriters conference and saw the movie. I thought the writer - Sue Smith - very clearly summarised what the film was about. However, the movie really didn't need explanation. ",
"When I saw the previews for this movie, I didn't expect much to begin with - around a second rate teen horror movie. ",
"Okay, sorry, but I loved this movie. I just love the whole 80's genre of these kind of movies, because you don't see many like this one anymore! "
), year = c(2011, 2012, 2012, 2012, 2012, 2012, 2012, 2012, 2013,
2013, 2013, 2013, 2013, 2013, 2013, 2013, 2014, 2014, 2014, 2014,
2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014, 2014,
2014, 2013, 2014, 2014, 2014, 2014, 2014, 2014, 2015, 2013, 2012,
2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015)), row.names = c(NA,
50L), class = "data.frame")
stopwords <- structure(list(V1 = c("a", "able", "ableabout", "about", "above",
"abroad", "abst", "accordance", "according", "accordingly", "across",
"act", "actually", "ad", "added", "adj", "adopted", "ae", "af",
"after", "afterwards", "ag", "again", "against", "ago", "ah",
"ahead", "ai", "aint", "ain't", "al", "all", "allow", "allows",
"almost", "alone", "along", "alongside", "already", "also",
"eleven", "else", "elsewhere", "embodiment", "empty", "end",
"ended", "ending", "ends", "enough", "entirely", "er", "es",
"especially", "et", "et-al", "etc", "even", "ever", "evermore",
"every", "everybody", "everyone", "everything", "everywhere",
"ex", "exactly", "example", "except", "f", "face", "faces", "fact",
"facts", "fairly", "far", "farther", "fed", "fell", "felt", "felt",
"few", "fewer", "ff", "fi", "fifteen", "fifth", "fifty", "fify",
"fig", "figs", "fill", "find", "finds", "fire", "first", "five",
"fix", "fj", "fk", "flew", "fm", "fo", "followed", "following",
"follows", "for", "forbade", "forever", "forgave", "forgot",
"formerly", "forth", "forty", "fought", "found", "found", "four",
"grouped", "grouping", "groups", "gs", "gt", "gu", "gw", "gy",
"h", "had", "had", "hadnt", "hadn't", "happens", "hardly", "has",
"hasn", "hasnt", "hasn't", "have", "haven", "havent", "haven't",
"having", "he", "heard", "hed", "he'd", "held", "hell", "he'll",
"hello", "hence", "her", "here", "hereafter", "hereby", "herein",
"heres", "here's", "hereupon", "hers", "herse”", "herself", "hes",
"he's", "hi", "hid", "hid", "him", "himse”", "himself", "his",
"hit", "hither", "hk", "hm", "hn", "hopefully", "how", "howbeit",
"immediately", "in", "in", "inasmuch", "inc", "inc.", "indeed",
"indicated", "inner", "inpit", "inside", "insofar", "instead",
"int", "interest", "interested", "interesting", "interests",
"into", "invention", "inward", "io", "iq", "ir", "is", "isn",
"isnt", "isn't", "it", "it", "itd", "it'd", "itll", "it'll",
"its", "it's", "itse”", "itself", "ive", "i've", "j", "je", "jm",
"jo", "join", "jp", "jpo", "just", "k", "ke", "keep", "keeps",
"kept", "kept", "keys", "kg", "kh", "ki", "kind", "km", "kn",
"knew", "knew", "know", "knows", "kp", "kr", "kw", "ky", "kz",
"l", "la", "laid", "largely", "lately", "later", "latter", "latterly",
"lay", "lb", "lc", "led", "left", "lent", "lest", "let", "let",
"lets", "let's", "li", "like", "liked", "likely", "likewise",
"lit", "little", "lk", "ll", "'ll", "longer", "longest", "look",
"looking", "looks", "lost", "lower", "lr", "ls", "lt", "ltd",
"lu", "lv", "ly", "m", "ma", "made", "made", "mainly", "make",
"makes", "making", "man", "many", "may", "maybe", "maynt", "mayn't",
"mc", "md", "me", "mean", "means", "meant", "meantime", "meanwhile",
"men", "merely", "met", "mg", "mh", "might", "mightnt", "mightn't",
"might've", "mil", "mill", "million", "mine", "minus", "miss",
"mk", "ml", "mm", "mn", "mo", "more", "moreover", "most", "mostly",
"needed", "needing", "neednt", "needn't", "needs", "neither",
"never", "neverf", "neverless", "nevertheless", "new", "newer",
"newest", "next", "nf", "ng", "ni", "nine", "ninety", "nl", "no",
"nobody", "non", "none", "nonetheless", "noone", "no-one", "nor",
"normally", "nos", "not", "noted", "nothing", "notwithstanding",
"novel", "now", "nowhere", "np", "nr", "nu", "null", "nz", "o",
"obtain", "obtained", "obviously", "of", "off", "often", "oh",
"ok", "okay", "old", "older", "oldest", "om", "on", "once", "one",
"ones", "one's", "only", "onto", "opened", "opposite", "or",
"ord", "order", "ordered", "ordering", "orders", "org", "other",
"others", "otherwise", "ought", "oughtnt", "oughtn't", "our",
"ours", "ourselves", "out", "over", "overall", "owing", "own",
"p", "pa", "paid", "parted", "particular", "particularly", "parting",
"parts", "past", "pe", "per", "perhaps", "pf", "pg", "ph", "pk",
"pl", "placed", "please", "plus", "pm", "pmid", "pn", "pointed",
"points", "poorly", "possible", "possibly", "potentially", "pp",
"pr", "predominantly", "preferably", "preferred", "present",
"presented", "presenting", "presents", "presumably", "previously",
"primarily", "probably", "promptly", "proud", "provide", "provided",
"provides", "pt", "put", "put", "puts", "pw", "py", "q", "qa",
"que", "quit", "quite", "qv", "r", "ran", "ran", "rang", "rather",
"rd", "re", "read", "readily", "really", "reasonably", "recent",
"recently", "ref", "refs", "regarding", "regardless", "regards",
"related", "relatively", "research", "reserved", "respectively",
"resulted", "resulting", "results", "right", "ring", "ro", "rode",
"rose", "ru", "run", "rw", "s", "sa", "said", "said", "sang",
"sank", "sat", "saw", "saw", "say", "saying", "says", "sb", "sc",
"sd", "se", "sec", "second", "secondly", "seconds", "see", "seeing",
"somewhat", "somewhere", "soon", "sorry", "specifically", "specified",
"specify", "specifying", "sped", "spent", "spoke", "spread",
"spun", "sr", "st", "states", "still", "stole", "stood", "stop",
"strongly", "struck", "stuck", "stung", "su", "sub", "substantially",
"successfully", "such", "sufficiently", "suggest", "suitable",
"that've", "the", "their", "theirs", "them", "themselves", "then",
"thence", "there", "thereafter", "thereby", "thered", "there'd",
"therefore", "therein", "therell", "there'll", "thereof", "thereof",
"therere", "there're", "theres", "there's", "thereto", "thereupon",
"thereve", "there've", "these", "they", "theyd", "they'd", "theyll",
"they'll", "theyre", "they're", "theyve", "they've", "thick",
"thing", "things", "think", "thinks", "third", "thirty", "this",
"this", "those", "thou", "though", "thoughh", "thought", "thousand",
"three", "threw", "throug", "through", "throughout", "thru",
"thus", "til", "till", "tip", "tis", "'tis", "tj", "tk", "tm",
"unlike", "unlikely", "until", "unto", "up", "ups", "upwards",
"us", "used", "useful", "usefully", "usefulness", "uses", "using",
"usually", "uucp", "uy", "uz", "v", "va", "various", "vc", "ve",
"'ve", "versus", "very", "vg", "vi", "via", "viz", "vn", "vol",
"vols", "vs", "vu", "w", "want", "wanted", "wanting", "wants",
"was", "wasn", "wasnt", "wasn't", "way", "ways", "we", "wed",
"we'd", "welcome", "well", "we'll", "wells", "went", "went",
"were", "were", "we're", "weren", "werent", "weren't", "weve",
"we've", "wf", "what", "what'd", "whatever", "whatll", "what'll",
"whats", "what's", "whatve", "what've", "when", "whence", "when'd",
"whenever", "when'll", "when's", "where", "whereafter", "whereas",
"whereby", "where'd", "wherein", "wherein", "where'll", "wheres",
"where's", "whereupon", "wherever", "whether", "which", "whichever",
"yourselves",
"youve", "you've", "yt", "yu", "z", "za", "zero", "zm", "zr")), row.names = c(NA,
-1308L), class = "data.frame")
topic_model <- function(data,stopWords){ #Notice capital W in 'stopWords'
##### PROGRESS BAR #####
snail_function <- function(){
for (i in 1:100){
Sys.sleep(1)
}
}
##### PRE-PROCESSING #####
data <- data %>% filter(Abstract != "") #Get NA's out
data$id <- seq(1:nrow(data)) #id set
toSpace <- function(x, pattern){ return (gsub(pattern, " ", x))}
patterns <- c("-","_","/","'","#","&",":",";","=")
for (i in 1:length(patterns)){ #Patterns to space
data$Abstract <- lapply(data$Abstract, toSpace, pattern = patterns[i])
}
i <- 1
clean <- c()
while(i <= nrow(data)) { #Return to character type
clean[i]<-as.character(data$Abstract[[i]])
i <- i + 1
}
data$Abstract <- clean
prep_fun <- function(x) {
x %>%
str_to_lower %>% #make text lower case
str_replace_all("[^[:alpha:]]", " ") %>% #remove non-alpha symbols
str_replace_all("\\s+", " ") %>% #collapse multiple spaces
str_replace_all("\\W*\\b\\w\\b\\W*", " ") #Remuevo letras individuales
}
tok_fun <- function(x) {
tokens <- word_tokenizer(x)
textstem::lemmatize_words(tokens) #remove inflectional word endings
}
it_patentes <- itoken(data$Abstract, #Vocabulary iterations
preprocessor = prep_fun,
tokenizer = tok_fun,
ids = data$id,
progressbar = F)
#Vocabulary setting
vocab <- create_vocabulary(it_patentes, ngram = c(ngram_min = 2L, ngram_max = 3L),
stopwords = stopWords)
pruned_vocab <- prune_vocabulary(vocab, term_count_min = mean(sort(vocab$term_count, decreasing = T)[1:10]) *.01,
doc_proportion_min = 0.001, vocab_term_max = 1000)
vectorizer <- vocab_vectorizer(pruned_vocab)
set.seed(17);dtm <- create_dtm(it_patentes, vectorizer,type = "dgTMatrix", progressbar = FALSE)
a0 <- (apply(dtm, 1, sum) > 0) #Build vector to identify non-empty docs
dtm <<- as.matrix(dtm[a0,] )
##### TOPIC MODELING #####
set.seed(17);lda_model <<- LDA$new(n_topics = 6, doc_topic_prior = 0.1, topic_word_prior = 0.01)
set.seed(17);doc_topic_distr <<- as.data.frame(lda_model$fit_transform(x = dtm, n_iter = 1000,
convergence_tol = 0.001, n_check_convergence = 25, progressbar = F))
twd <<- lda_model$topic_word_distribution
}
ui <- fluidPage(
tabPanel("Analizing & Modeling",
titlePanel(div(h3(HTML(paste0("<b>","IP modeling","</b>"))),align = "left")),
tags$br(),
fluidRow(
sidebarPanel(
tags$hr(style="border-color: #606060;"),
div(h4(HTML(paste0("<b>","Latent Dirichlet Allocation","</b>"))),style = "font-size: 100%; width: 100%, text-align:center"),
br(),
div(actionButton("go", "Apply LDA modeling"),style = "font-size: 100%; width: 100%; text-align:center"),
br(),
h5("If λ = 1, plot is according simple frequencies; when λ = 0, it's about the ratio of the frequency given the cluster to the overall frequency of the term."),
tags$hr(style="border-color: #606060;"),
plotOutput("bar"),
tags$hr(style="border-color: #606060;"),
width = 3
),
mainPanel(
br(),
visOutput("LDAplot"),
width = 9
)
)
)#, #tabPanel - Analizing & Modeling
)
server <- function(input, output, session) {
# --- Analizing Tab
# Model application #Applied to df
dats <- reactiveValues()
model_data <- eventReactive(input$go, { #Function requirements
stopWords <- as.character(unique(stopword[,1])) #Notice capital W in that name
dats <- data
topic_model(dats,stopWords)
return(list(lda_model, doc_topic_distr, twd))
}) # eventReactive - modeling
# LDAplot output
output$LDAplot <- renderVis({
model_data()[[1]]$plot(out.dir = "SOME_DIR", open.browser = FALSE)
readLines("SOME_DIR/lda.json")
}) #renderVis
}
shinyApp(ui = ui,server = server)
Может кто-нибудь сказать, пожалуйста, как я могу получить индикатор выполнения, когда сюжет выходит? Добавлено полное кодирование, чтобы он работал в качестве воспроизводимого образца.