CODEWITHSUNDEEP
rshiny
Sebastian Zeki
Sebastian Zeki

Reputation: 6874

Dynamically create a shiny timeline based on a dataframe

I want to create a timeline that is based on some dates in a data frame. I am using shinydashboardplus for this.

At the moment I can create the timeline elements but I am not sure how to create them based on the year so that I have a separate timelineLabel followed by the relevant timelineItem

My attempt is here:

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)


mytimeItem <-
  function (...,
            icon = NULL,
            color = NULL,
            time = NULL,
            title = NULL,
            border = TRUE,
            footer = NULL)
  {
    data <- paste0(..., collapse = "<br><br>")
    cl <- "fa fa-"
    if (!is.null(icon))
      cl <- paste0(cl, icon)
    if (!is.null(color))
      cl <- paste0(cl, " bg-", color)
    itemCl <- "timeline-header no-border"
    if (isTRUE(border))
      itemCl <- "timeline-header"
    shiny::tags$li(
      shiny::tags$i(class = cl),
      shiny::tags$div(
        class = "timeline-item",
        shiny::tags$span(class = "time", shiny::icon("clock-o"), time),
        shiny::tags$h3(class = itemCl, title),
        shiny::tags$div(class = "timeline-body",
                        HTML(data)),
        shiny::tags$div(class = "timeline-footer", footer)
      )
    )
  }


df <- data.frame(
  date=c(2018,2018,2018,2017,2016),
  title=c("This","is","my","yearly","timeline")
)

ui <-dashboardPagePlus(
  dashboardHeaderPlus(title="My Timeline app"),
  dashboardSidebar(
    sidebarMenu(
    )
  ),
  dashboardBody(
    box(
      width = 6,
      uiOutput("timeline")
    )
  )
)


server <- function(input, output,session) {

  
  ##timeline--------------------------------------------------------------------------
  
  refresh <- reactive({
    input$submit
    1
  })
  
  output$timeline <- renderUI({
    refresh()

    disttime <- unique(df$date)
    timelineBlock(
  reversed = FALSE,
  timelineEnd(color = "danger"),
  timelineLabel(disttime[1], color = "teal"),
  lapply(as.character(df[1:nrow(df),2]), function(x)
  mytimeItem(
    title = "文件",
    icon = "gears",
    color = "olive",
    time = "now",
    footer ="",
    x


     ))
  )
      })
    }

shinyApp(ui = ui, server = server)

This issue I have is with this part:

timelineBlock(
      reversed = FALSE,
      timelineEnd(color = "danger"),
      timelineLabel(df[1], color = "teal"),
      lapply(df[2], function(x)
      mytimeItem(
        title = "OGD",
        icon = "gears",
        color = "olive",
        time = "now",
        footer ="",
        x
      ))
  )

I think I need a nested lapply but I'm not sure how to construct it so that I get the timelineLabel for each year

Upvotes: 2

Views: 346

Answers (1)

JohannesNE
JohannesNE

Reputation: 1363

Split the data frame by date first. Create a timelineLabel for each of the sub data frames:

output$timeline <- renderUI({
    refresh()
    
    timelineBlock(
      reversed = FALSE,
      timelineEnd(color = "danger"),
      lapply(split(df, df$date), function(x) {
        list(
          timelineLabel(x$date[1], color = "teal"),
          
          lapply(x$title, function(title) 
            mytimeItem(
              title = "OGD",
              icon = "gears",
              color = "olive",
              time = "now",
              footer ="",
              title
            )
          )
        )}
      )
      
      
        
    )
  })

Upvotes: 1

Related Questions