1

我已经创建了一个类似的问题，但这个问题更复杂。举个简单的例子，假设我创建了这个应用程序

library(timevis)
library(shiny)
library(shinydashboard)

df_original <- data.frame(id =c(1),
                 text1 =c('d'),
                 text2 =c('h'),
                 text3 =c('l'),
                 time1 =c('2019-01-08 20:30:00'),
                 time2 =c('2019-01-08 20:40:00'),
                 time3 =c('2019-01-08 20:50:00'),
                 time4 =c('2019-01-08 21:00:00'),
                 time5 =c('2019-01-08 20:48:00'),
                 time6 =c('2019-01-08 20:34:00'))

df_original$time1 <- as.POSIXct(df_original$time1,format="%Y-%m-%d %H:%M:%S")
df_original$time2 <- as.POSIXct(df_original$time2,format="%Y-%m-%d %H:%M:%S")
df_original$time3 <- as.POSIXct(df_original$time3,format="%Y-%m-%d %H:%M:%S")
df_original$time4 <- as.POSIXct(df_original$time4,format="%Y-%m-%d %H:%M:%S")
df_original$time5 <- as.POSIXct(df_original$time5,format="%Y-%m-%d %H:%M:%S")
df_original$time6 <- as.POSIXct(df_original$time6,format="%Y-%m-%d %H:%M:%S")

##############################################UI

header <- dashboardHeader(title = "")

#Sidebar
sidebar <- dashboardSidebar(
  #DF type menu
  selectInput(inputId = 'df',
              label = 'Type of DF',
              choices = c('DF1', 'DF2', 'DF3', 'DF4'),
              selected = 'DF1')
)

#Text Row
frow1 <- fluidRow(box(width = 12,
                      splitLayout(
                        textOutput("text1"),
                        textOutput("text2"),
                        textOutput('text3'))
))

#Timeline Row
frow2 <- fluidRow(box(timevisOutput("timeline"),width = NULL
                      ))

#Body function
body <- dashboardBody(frow1,frow2)

#UI aggregation
ui <- dashboardPage(header, sidebar, body, skin = 'black')

###############################Server
server <- function(input, output, session){
  
  #Converting Df original to timevis ready data
  
  Summary <- reactive({
    #Transposing
    agg <- data.frame(r1=names(df_original), t(df_original))
    colnames(agg) <- c("content","start")
    #Removing text columns
    agg <- agg[-c(1,2,3,4),]
    #Adding group id
    agg$group <- c(1,2,3,4,1,2)
    #Rearranging columns
    agg <- agg[c(2,3,1)]
    agg$start <- ymd_hms(agg$start)
    agg$content <- as.factor(agg$content)
    #Adding section column to tell which timestamp belong to which DF when switching
    agg$section <- c(4,2,3,4,3,2)
    agg$section <- as.numeric(agg$section)
    return(data.frame(agg))
  })
  
  
  #if condition for DF1,DF2,DF3,DF4
  
  df <-reactive({
    if (input$df == "DF2") {
      df <- Summary()[which(Summary()$section == 2),]
    }
    else if (input$df == "DF3") {
      df <- Summary()[Summary()$section == 3,]
    }
    else if (input$df == "DF4") {
      df <- Summary()[(Summary()$section == 4),]
    }
    else {
      df <- Summary()
    }
    return(df)
  })
  
  output$timeline <- renderTimevis(
    timevis(
      df(),
      groups = data.frame(id = 1:4, content = c('Group1','Group2','Group3','Group4'))
      ,options = list( showCurrentTime = FALSE)
    )
  )
  
  output$text1 <- renderText({paste("Text1:", df_original$text1)})
  output$text2 <- renderText({paste("Text2:", df_original$text2)})
  output$text3 <- renderText({paste("Text3:", df_original$text3)})

}

#####################################Execution
shinyApp(ui, server)

在这里，我有 3 个文本列和 3 个时间戳。我必须将文本显示为输出广告，然后根据时间戳显示时间线。时间戳需要分组。这是棘手的部分。我还必须根据用户的输入更改我的时间线——用户是想查看某些时间戳组还是所有时间戳。该组不同于前面划分时间线的组。输出是这样的 基本输出

在这里，当您更改 df 的类型时，它将根据服务器代码中定义的部分更改时间线。

如何为这样的数据框创建类似的应用程序

df <- data.frame(id =c(1,2,3,4),
                 text1 =c('a','b','c','d'),
                 text2 =c('e','f','g','h'),
                 text3 =c('i','j','k','l'),
                 time1 =c('2019-01-08 20:00:00','2019-01-08 20:35:00','2019-01-08 21:10:00','2019-01-08 20:30:00'),
                 time2 =c('2019-01-08 20:10:00','2019-01-08 20:50:00','2019-01-08 21:00:00','2019-01-08 20:40:00'),
                 time3 =c('2019-01-08 21:20:00','2019-01-08 20:40:00','2019-01-08 21:20:00','2019-01-08 20:50:00'),
                 time4 =c('2019-01-08 22:30:00','2019-01-08 20:45:00','2019-01-08 21:30:00','2019-01-08 21:00:00'),
                 time1 =c('2019-01-08 20:23:00','2019-01-08 20:55:00','2019-01-08 21:23:00','2019-01-08 20:48:00'),
                 time1 =c('2019-01-08 20:16:00','2019-01-08 20:48:00','2019-01-08 21:16:00','2019-01-08 20:34:00'))

这样我的输出就以多个时间线的形式出现——每个 ID 一个时间线——在一个闪亮的应用程序中。输出会像这样期望的输出

4

0 回答 0