shinyboard :: dropdown notifications menu

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)