shinyboard :: dropdown notifications menu

Published by onesixx on

library(shiny)
library(shinyjs)
library(shinydashboard)

header  <- dashboardHeader(dropdownMenuOutput("taskMenu"))
sidebar <- dashboardSidebar()
body    <- dashboardBody(useShinyjs())
ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  uFunc_memory_info <-  function(){
    mem <- system("free -g", intern=T)
    mem <- str_split(mem, pattern = "\\s{2,}" )
    mem_all  <- as.numeric(mem[[2]][2])
    mem_use  <- as.numeric(mem[[2]][3])
    swap_all <- as.numeric(mem[[3]][2])
    swap_use <- as.numeric(mem[[3]][3])
    #curr_systime <- system("date +%T", intern=T)
    
    descption1 <- str_c("Mem : ",mem_use,"GB/",mem_all,"GB")
    mem_usage1 <- ((mem_use/mem_all)*100) %>% round(1)
    if (mem_usage1<25) {bar_color1 <- "blue"
    } else if (mem_usage1<50) { bar_color1 <-"green"
    } else if (mem_usage1<75) { bar_color1 <- "red"
    } else {bar_color1 <- "black"}    
    
    descption2 <- str_c("Swap : ",swap_use,"GB/",swap_all,"GB" )
    mem_usage2 <- ((swap_use/swap_all)*100) %>% round(1)
    if (mem_usage2<25) {bar_color2 <- "blue"
    } else if (mem_usage2<50) { bar_color2 <-"green"
    } else if (mem_usage2<75) { bar_color2 <- "red"
    } else {bar_color2 <- "black"}    
    
    taskData1 <- data.frame(text=descption1, value=mem_usage1, color=bar_color1)
    taskData2 <- data.frame(text=descption2, value=mem_usage2, color=bar_color2)
    taskData  <- rbind(taskData1, taskData2)
    
    mem_row <- apply(taskData, 1, function(row) {
      taskItem(text = row[["text"]],  value = row[["value"]], color = row[["color"]])
    })
    return(mem_row)
  }
  r_val <- reactiveValues(tasklist=0)
  onevent(event="mouseover", id="taskMenu", expr=r_val$task_list<-uFunc_memory_info(), add=FALSE)
  
  output$taskMenu <- renderMenu({
    dropdownMenu(type = "tasks", headerText="Memory Usage", .list = r_val$task_list)
  })
}

shinyApp(ui, server)

 

https://github.com/rstudio/shinydashboard/issues/51

## https://github.com/rstudio/shinydashboard/issues/51

library(shiny)
library(shinydashboard)
library(googleVis)

header <- dashboardHeader(
            dropdownMenuOutput("messageMenu"),
            dropdownMenuOutput("notificationMenu"),
            dropdownMenuOutput("taskMenu")
        )
sidebar <- dashboardSidebar(
            sidebarUserPanel("Dave",
              subtitle = a(href="#", icon("circle", class="text-success"), "Online")
            ),
            sidebarMenu(
              menuItem(
                "Dashboard", tabName="dashboard", icon=icon("dashboard") ),
              menuItem(
                "Widgets",   tabName="widgets",   icon=icon("th"), badgeLabel="new", badgeColor="green" )
            )
          )
body <- dashboardBody(
          tabItems(
            tabItem(tabName = "dashboard",
              fluidRow( # infoBoxes with fill=FALSE
                # A static & Dynamic infoBoxes
                infoBox("Demand", 10 * 2, icon = icon("line-chart")),
                infoBoxOutput("progressBox"),
                infoBoxOutput("approvalBox")
              ),
              fluidRow( # infoBoxes with fill=TRUE
                infoBox("Price", 5 * 2, icon = icon("heart"), fill = TRUE),
                infoBoxOutput("progressBox2"),
                infoBoxOutput("approvalBox2")
              ),
              fluidRow(# Clicking this will increment the progress amount
                box(width = 4, 
                  actionButton("count", "Increment progress"))
              )
            ),
            tabItem( tabName = "widgets",
              fluidRow(
                box(
                  plotOutput("plot1", height = 250)),
                box(title = "Controls",
                  sliderInput("slider", "Number of observations:", 1, 100, 50))
              )
            )
          )
        )
ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  set.seed(122)
  histdata <- rnorm(500)
  
  txtdata <- "type	        from	  message	            status	color	  value
              message	      1	      message_body	      danger	red	    1
              notification	2	      notification_body	  warning	blue	  2
              task	        3	      task_body	          info	  yellow	3" 
  menu.df <- read.table(textConnection(txtdata), header = TRUE)
  closeAllConnections()
  
  #partition menu data into message, notification, and task
  messageData      <- subset(menu.df, type=="message")
  notificationData <- subset(menu.df, type=="notification")
  taskData         <- subset(menu.df, type=="task")
  
  output$messageMenu <- renderMenu({
    msgs <- apply(messageData, 1, function(row) {
      messageItem(from = row[["from"]], message = row[["message"]])
    })
    dropdownMenu(type = "messages", .list = msgs)
  })
  
  output$notificationMenu <- renderMenu({
    nots <- apply(notificationData, 1, function(row) {
      notificationItem(text = row[["message"]], status = row[["status"]])
    })
    dropdownMenu(type = "notifications", .list = nots)
  })
  
  output$taskMenu <- renderMenu({
    taks <- apply(taskData, 1, function(row) {
      taskItem(text = row[["message"]], color = row[["color"]], value = row[["value"]])
    })
    dropdownMenu(type = "tasks", .list = taks)
  })
  
  datasetInput <- reactive({
    switch( input$dataset,
      "rock"     = rock,
      "pressure" = pressure,
      "cars"     = cars
    )
  })
  
  output$view <- renderGvis({
    gvisScatterChart(dropDownMenus, options = list(width = 400, height = 450))
  })
  
  output$plot1 <- renderPlot({
    data <- histdata[seq_len(input$slider)]
    hist(data)
  })
  
  output$plot2 <- renderPlot({
    data <- histdata[seq_len(input$slider)]
    hist(data)
  })
  
  output$progressBox <- renderInfoBox({
    infoBox( "Progress", paste0(25 + input$count, "%"), icon = icon("list"), color = "purple")
  })
  
  output$approvalBox <- renderInfoBox({
    infoBox("Confidence", "80%", icon = icon("eye-open", lib = "glyphicon"), color = "yellow")
  })
  
  # Same as above, but with fill=TRUE
  output$progressBox2 <- renderInfoBox({
    infoBox("Managed Spend (mil)", paste0("USD ", 25 + input$count), icon = icon("dollar"), color = "purple", fill = TRUE)
  })
  output$approvalBox2 <- renderInfoBox({
    infoBox("Model Performance", "80%", icon = icon("thumbs-up", lib = "glyphicon"), color = "green", fill = TRUE)
  })
}

shinyApp(ui, server)

 

 

Categories: PjR-Shiny

onesixx

Blog Owner

Subscribe
Notify of
guest

0 Comments
Inline Feedbacks
View all comments
0
Would love your thoughts, please comment.x
()
x