Блог

Я создал аналогичный вопрос, но этот более сложный. Для минимального примера предположим, что я создаю это приложение

 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'))
 

таким образом, мои выходные данные представлены в виде нескольких графиков — по одному для каждого идентификатора — в одном блестящем приложении. Результат будет выглядеть так