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("[\r\n]", "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

}

我试图将这个玩具示例变成一个闪亮的网络应用程序。 this question的已接受答案对于让我开始并且我可以上传文件非常有用，但我不确定如何在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')
               )
             )
    )

  )
)
)

sever.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）。

其次，如何调用我的绘图功能输出闪亮的情节？

Answer 1

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

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

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

上传文件和调用函数以在闪亮的应用程序中绘制数据

1 个答案: