r-上传文件并调用函数来绘制闪亮应用程序中的数据

Question

我有一个包含聊天日志的文件：

24/01/2016, 11:50:17 pm: ‎Line to skip
24/01/2016, 11:50:17 pm: ‎Line to skip
25/01/2016, 11:51:47 pm: User1: Message one is here
25/01/2016, 11:53:04 pm: User2: A long message that spans multiple lines, so I have to write a really long and tedious message here to illustrate my point. The point is that this message is really long and 
can
[span]
Several lines.
24/01/2016, 11:51:47 pm: User3: My first message
27/10/2017, 12:54:03 am: ‎‪+44 ‬012 3456789 left
28/10/2017, 02:54:03 pm: User3: My second message!

---

rawData <- structure(list(V1 = c("24 01 2016, 11:50:17 pm: ‎Line to skip", 
"24 01 2016, 11:50:17 pm: ‎Line to skip", "24 01 2016, 11:51:47 pm: User1: Message one is here", 
"24 01 2016, 11:53:04 pm: User2: A long message that spans multiple lines, so I have to write a really long and tedious message here to illustrate my point. The point is that this message is really long and ", 
"can", "[span]", "Several lines.", "24 01 2016, 11:51:47 pm: User3: My first message", 
"27 10 2017, 12:54:03 am: ‎‪+44 ‬012 3456789 left")), .Names = "V1", row.names = c(NA, 
-9L), class = "data.frame")

在我的脚本中，我有一个解析文件的函数，还有一个绘制每个用户帖子数量的函数：

# Parse the file: 
parseR <- function(file='data/chatlog.txt',drop="44"){
rawData <- read.delim(file, quote = "", 
row.names = NULL, 
stringsAsFactors = FALSE,
header = F)
# join multi line messages into single line
# rawData$V1<-gsub("[rn]", "Hello", rawData$V2)
rawData$V1<-gsub("http", ' ', rawData$V1)
# replace '/' with spaces
rawData$V1<-gsub("/", " ", rawData$V1)
sepData<-suppressWarnings(separate(rawData, V1, c("datetime", "sender", "message"), sep = ": ", extra = "merge"))

sepData$message <- trimws(sepData$message)
sepData$sender<-factor(sepData$sender)
data <- sepData %>% 
filter(!is.na(message)) %>%
filter(!grepl(drop, sender)) %>%
droplevels() 
# data$date_time<-strsplit(data$date_time, '_')
# data$datetime<-dmy_hms(data$datetime,tz=NULL)
data$datetime<-dmy_hms(data$datetime, tz=NULL)
cleanData<-separate(data, datetime, c("date", "time"), sep = " ", remove =TRUE)
cleanData$date<-ymd(cleanData$date)
cleanData$time<-hms(cleanData$time)
return(cleanData)
}
# Plot the number of posts per user
senderPosts <- function(){
data <- parseR()
postCount<-as.data.frame(cbind(table(data$sender)))
postCount <- data.frame(names = row.names(postCount), postCount)
rownames(postCount)<-NULL
colnames(postCount)<-c("name", "posts")
postCount <- transform(postCount, name = reorder(name, -posts))
# Plot bar
p <- ggplot(postCount)
p <- p + geom_bar(aes(name, posts),stat='identity')
p <- p + scale_y_continuous("Number of posts", breaks=seq(0,max(postCount$posts),by=100))
p <- p + cleanTheme()
p
}

我正试图将这个玩具示例制作成一个闪亮的网络应用程序。这个问题的公认答案对我的入门非常有用，我可以上传文件，但我不确定如何在sever.R中实际集成我的功能。我应该将函数开发为一个包，然后在sever.R中加载，还是可以将上传的文件传递给sever.R脚本本身中的函数？

到目前为止，我得到的是：

ui.R

library(shiny)
suppressMessages(library("wordcloud"))
shinyUI(fluidPage(
titlePanel("Column Plot"),
tabsetPanel(
tabPanel("Upload File",
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose CSV File',
accept='.txt'
),
tags$br()
),
mainPanel(
tableOutput('contents')
)
)
)
)
)
)

服务器。R

library(shiny)
suppressMessages(library(ggplot2))
suppressMessages(library(dplyr))
suppressMessages(library(plyr))
suppressMessages(library(tidyr))
suppressMessages(library(lubridate))
shinyServer(function(input, output) {
output$contents <- renderTable({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
rawData <- read.delim(inFile$datapath, quote = "", 
row.names = NULL, 
stringsAsFactors = FALSE,
header = F)
rawData$V1<-gsub("http", ' ', rawData$V1)
# replace '/' with spaces
rawData$V1<-gsub("/", " ", rawData$V1)
sepData<-suppressWarnings(separate(rawData, V1, c("datetime", "sender", "message"), sep = ": ", extra = "merge"))
sepData$message <- trimws(sepData$message)
sepData$sender<-factor(sepData$sender)
data <- sepData %>% 
filter(!is.na(message)) %>%
filter(!grepl(drop, sender)) %>%
droplevels() 
data$datetime<-lubridate::dmy_hms(data$datetime)
cleanData<-separate(data, datetime, c("date", "time"), sep = " ", remove =TRUE)
cleanData$date<-lubridate::ymd(cleanData$date)
cleanData$time<-lubridate::hms(cleanData$time)
head(cleanData)
})
})

首先，输出head(cleanData):存在一些问题

• 当我在Rstudio中运行head(parseR())时，我得到了我想要的输出：

---

structure(list(date = structure(c(16825, 16825, 16824, 17467), class = "Date"), 
time = structure(c(47, 4, 47, 3), year = c(0, 0, 0, 0), month = c(0, 
0, 0, 0), day = c(0, 0, 0, 0), hour = c(23, 23, 23, 14), minute = c(51, 
53, 51, 54), class = structure("Period", package = "lubridate")), 
sender = structure(c(1L, 2L, 3L, 3L), .Label = c("User1", 
"User2", "User3"), class = "factor"), message = c("Message one is here", 
"A long message that spans multiple lines, so I have to write a really long and tedious message here to illustrate my point. The point is that this message is really long and", 
"My first message", "My second message!")), .Names = c("date", 
"time", "sender", "message"), row.names = c(NA, 4L), class = "data.frame")

---

• 但当我运行应用程序时，日期和时间没有正确解析(我使用的是lubriudate)

其次，我如何调用我的plot函数来输出闪亮的plot？

Answer 1

就像在server.R中用renderTable包装表，在ui.R中调用tableOutput('contents')一样，您需要在renderPlot中包装图，在ui.R中调用plotOutput('...')。

你的意思是表输出格式错误/难看吗？一种解决方法是将所有内容强制转换为字符串，并使用format来获得所需的格式。

您可以将函数放在server.R中的shinyServer(function(input, output) { ... }调用之前，并在shinyServer中调用函数。