r - 使用闪亮的点击操作更新图表和数据
问题描述
我有一个包含 3 个操作的应用程序,
通过单击按钮加载数据(左上角) - 现在应该输出图表
通过在删除正文中输入一个单词并单击“执行”来删除单词 - 应该更新图表
替换一个词,购买将要替换的词放在“查找”中,替换在“替换”中并点击动作
我面临的问题是只有当我点击“go”然后“act”时才会显示图表,只有在我到达“act”时才会显示图表
library(shiny)
library(plyr)
library(sp)
library(stringr)
library(tidyr)
library(tidyverse)
library(tm)
library(ggplot2)
library("stringi")
library(plyr)
library(dplyr) #Data manipulation (also included in the tidyverse package)
ui <- fluidPage(
fluidRow(
column( 4, titlePanel("Twitter Analytics")),
column( 3),
column( 4,
textInput("searchstring",
label = "",
value = "")),
column(1,
br(),
actionButton("action", "go"))
),
fluidRow(
column( 12, tabsetPanel(
tabPanel("one",
fluidRow(
column(3, textInput("removeString", label = "remove", value = ""), actionButton("remove", "do"),
textInput("find", label = "find", value = ""),textInput("rep", label = "replace", value = ""),actionButton("replace", "act"),
checkboxGroupInput("checkGroup", "select plots",
choices <- c("Histogram", "Wordcloud", "network")),
sliderInput("topTerms",
label = "top (n) terms",
min = 0, max = 25, value = 0) ),
column(9,fluidRow(column(12,plotOutput("ttext") )),
fluidRow(column(12,wordcloud2Output("wc2"))))
)
),
tabPanel("two"),
tabPanel("three")
)
)
)
)
server <- function(input, output) {
values <- reactiveValues(go = 0, do = 0, act = 0 )
observeEvent(input$action, {
values$go <- 1
values$do <- 0
values$act <- 0
})
observeEvent(input$remove, {
values$go <- 0
values$do <- 1
values$act <- 0
})
observeEvent(input$replace, {
values$go <- 0
values$do <- 0
values$act <- 1
})
#tweet <- eventReactive(input$action,{
cs<- reactiveVal(0)
tweet <-reactive({
if(values$go){
num <- c(1,2,3,4,50)
text <- c("this is love love something", "this is not hate hate hate something", "@something islove rethched this not", " Shiny is love confusing me", "this is hate also somthing difficult")
letter<- c("a", "b", "c", "D", "e")
tweetdf <- data.frame(num, text, letter)
tweetdf$text <- tolower(tweetdf$text)
# tweetdf @UserName
tweetdf$text <- gsub("@\\w+", "", tweetdf$text)
#remove punctuation
tweetdf$text <- gsub("[[:punct:]]", "", tweetdf$text)
#remove links
tweetdf$text <- gsub("http\\w+", "", tweetdf$text)
# Remove tabs
tweetdf$text <- gsub("[ |\t]{2,}", "", tweetdf$text)
# Remove blank spaces at the beginning
tweetdf$text <- gsub("^ ", "", tweetdf$text)
# Remove blank spaces at the end
corpus <- iconv(tweetdf$text, to = "ASCII")
corpus <- Corpus(VectorSource(corpus))
corpus <- tm_map(corpus, removePunctuation)
corpus <- tm_map(corpus, removeNumbers)
cleanset <- tm_map(corpus, removeWords, stopwords('english'))
cs(cleanset)}
if(values$do){
cleanset <- cs()
cleanset <- tm_map(cleanset, removeWords, input$removeString)
cs(cleanset)
}
if(values$act){
cleanset <- cs()
cleanset <- tm_map(cleanset, gsub,
pattern = input$find,
replacement = input$rep)
cs(cleanset)
}
else
{return()}
})
output$ttext <- renderPlot({
if(is.null(tweet())){return()}
else{
cleanset <-cs()
tdm <- TermDocumentMatrix(cleanset)
tdm <- as.matrix(tdm)
w <- rowSums(tdm)
library(RColorBrewer)
barplot(w)}
})
output$wc2 <- renderWordcloud2({
if(is.null(tweet())){return()}
else{
library(wordcloud2)
cleanset <-cs()
tdm <- TermDocumentMatrix(cleanset)
tdm <- as.matrix(tdm)
w <- rowSums(tdm)
w <- data.frame(names(w), w)
colnames(w) <- c('word', 'freq')
wordcloud2(w,
color = 'random-dark',
size = 0.7,
shape = 'circle',
rotateRatio = 0.5,
minSize = 1)}
})
}
shinyApp(ui, server)
谁能告诉我出了什么问题我几天前才开始使用闪亮?
解决方案
问题来自您使用多个 if 的事实。R 不知道要返回什么。所以你可以使用这个服务器,你不需要将 0 替换为FALSE
.
server <- function(input, output) {
values <- reactiveValues(go = 0, do = 0, act = 0 )
observeEvent(input$action, {
values$go <- T
values$do <- F
values$act <- F
})
observeEvent(input$remove, {
values$go <- F
values$do <- T
values$act <- F
})
observeEvent(input$replace, {
values$go <- F
values$do <- F
values$act <- T
})
#tweet <- eventReactive(input$action,{
cs <- reactiveVal(0)
tweet <- reactive({
cleanset <- cs()
if(values$go){
num <- c(1, 2, 3, 4, 50)
text <- c("this is love love something", "this is not hate hate hate something",
"@something islove rethched this not", " Shiny is love confusing me", "this is hate also somthing difficult")
letter<- c("a", "b", "c", "D", "e")
tweetdf <- data.frame(num, text, letter)
tweetdf$text <- tolower(tweetdf$text)
# tweetdf @UserName
tweetdf$text <- gsub("@\\w+", "", tweetdf$text)
# Remove punctuation
tweetdf$text <- gsub("[[:punct:]]", "", tweetdf$text)
# Remove links
tweetdf$text <- gsub("http\\w+", "", tweetdf$text)
# Remove tabs
tweetdf$text <- gsub("[ |\t]{2,}", "", tweetdf$text)
# Remove blank spaces at the beginning
tweetdf$text <- gsub("^ ", "", tweetdf$text)
# Remove blank spaces at the end
corpus <- iconv(tweetdf$text, to = "ASCII")
corpus <- Corpus(VectorSource(corpus))
corpus <- tm_map(corpus, removePunctuation)
corpus <- tm_map(corpus, removeNumbers)
cleanset <- tm_map(corpus, removeWords, stopwords('english'))
return(cs(cleanset))}
else if(values$do){
cleanset <- tm_map(cleanset, removeWords, input$removeString)
return(cs(cleanset))
}
else if(values$act){
cleanset <- tm_map(cleanset, gsub,
pattern = "input$find",
replacement = "input$rep")
return(cs(cleanset))
}
else
{return()}
})
output$ttext <- renderPlot({
if(is.null(tweet())){
return()}
else{
cleanset <- cs()
tdm <- TermDocumentMatrix(cleanset)
tdm <- as.matrix(tdm)
w <- rowSums(tdm)
barplot(w)}
})
output$wc2 <- renderWordcloud2({
if(is.null(tweet())){return()}
else{
cleanset <-cs()
tdm <- TermDocumentMatrix(cleanset)
tdm <- as.matrix(tdm)
w <- rowSums(tdm)
w <- data.frame(names(w), w)
colnames(w) <- c('word', 'freq')
wordcloud2(w,
color = 'random-dark',
size = 0.7,
shape = 'circle',
rotateRatio = 0.5,
minSize = 1)}
})
}
推荐阅读
- matplotlib - 在 matplotlib 中使用项目符号
- .net - 无法使用 azure Eventthub 在架构注册表中创建架构
- sql - 使用从较少的空值到无空值的列对行进行排序
- function - Common Lisp:给函数的参数太少但找不到问题
- blazor - Blazor 组件未在 statechange 上调用 OnInitializedAsync,链式数据获取
- windows - 在带有 QProcess 的 Windows 64 位操作系统上使用 Qt 32 位套件编译 Qt 程序
- r - 如何使用 Rcpp::plugins(openmp) 制作可移植文件,该文件可以是 Rcpp::sourceCpp'ed
- visual-studio-code - 将 .sublime-syntax (YAML) 转换为 VSCode 兼容的语法
- java - SpringBoot + REST,Cross-Origin Request Blocked: 原因:CORS 请求没有成功
- python - 试图包装凯撒密码(Python)