Is there a way to use a custom icon on infoBox on shinydashboard. I am trying to use the example on hrbrmstr gist but it I can not find the place to update the infoBox function.
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(width = 2, actionButton("count", "Count")),
infoBoxOutput("ibox"),
valueBoxOutput("vbox")
)
)
)
server <- function(input, output) {
output$ibox <- renderInfoBox({
infoBox(
"Title",
input$count,
#icon = icon("credit-card")
icon=icon(list(src=x, width="80px"), lib="local")
)
})
output$vbox <- renderValueBox({
valueBox(
"Title",
input$count,
icon = icon("credit-card")
)
})
}
shinyApp(ui, server)
I used the apputils package from leonawicz. I replaced the infoBox function with the apputils::infoBox.
library(shiny)
library(apputils)
#exApp("icons")
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(width = 2, actionButton("count", "Count")),
infoBoxOutput("ibox"),
valueBoxOutput("vbox")
)
)
)
server <- function(input, output) {
output$ibox <- renderInfoBox({
ic <- apputils::icon(list(src = "https://cdn1.iconfinder.com/data/icons/money-47/512/Money_Currency_Finance-41-512.png", width = "80px"), lib = "local")
apputils::infoBox(
"Title",
input$count,
icon = ic
#icon = icon("credit-card")
#icon=icon(list(src=x, width="80px"), lib="local")
)
})
output$vbox <- renderValueBox({
valueBox(
"Title",
input$count,
icon = icon("credit-card")
)
})
}
shinyApp(ui, server)
Related
I started building my first shiny app but am now struggling with a strange behaviour. First, when I initially load the app, no tab is selected by default. Second, when clicking on any menu on the sidebar it shows the body only on the first time. When I go from "Overview" to "Pivot-Tabelle" and back, the body is blank. What am I missing? Below is the code I used.
library(shiny)
library(shinydashboard)
df<-data.frame(a=c(1,2,3,4),
b=c("A","B","C","D"))
###################Beginn der App################
ui <- dashboardPage(
# Application title
dashboardHeader(),
##----DashboardSidebar----
dashboardSidebar(
menuItem("Overview", tabName = "overview",selected=TRUE),
menuItem("Pivot-Tabelle", tabName = "pivot"),
menuItem("Test", tabName = "farmer")
),
##----DashboardBody----
dashboardBody(
tabItems(
##----TabItem: Overview----
tabItem(tabName="overview",
fluidRow(
valueBoxOutput("A"),
valueBoxOutput("B")
)
),
###----TabItem:Pivot----
tabItem(tabName = "pivot",
##Pivot
column(6,offset=4,titlePanel("Daten-Explorer")),
column(12,
mainPanel(
rpivotTableOutput("pivot")
)
)
),
##----TabItem:Test----
tabItem(tabName = "Test",
h2("In Progress"))
)
)
)
server <- function(input, output) {
##----server:overview----
output$A<-renderValueBox({
valueBox(
paste0(25, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
output$B<-renderValueBox({
valueBox(
paste0(55, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
##----server:pivot----
output$pivot <- renderRpivotTable({
rpivotTable(data = df)
})
}
# Run the application
shinyApp(ui = ui, server = server)
This seems to work. You need to have sidebarMenu for your menuItems. Also, you need to change tabName to farmer so it matches your menuItem. And I don't think you need mainPanel in there (you can use mainPanel with sidebarPanel as part of a sidebarLayout if you wanted that layout - see layout options). See if this works for you.
library(shiny)
library(shinydashboard)
library(rpivotTable)
df<-data.frame(a=c(1,2,3,4),
b=c("A","B","C","D"))
###################Beginn der App################
ui <- dashboardPage(
# Application title
dashboardHeader(),
##----DashboardSidebar----
dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName = "overview",selected=TRUE),
menuItem("Pivot-Tabelle", tabName = "pivot"),
menuItem("Test", tabName = "farmer")
)
),
##----DashboardBody----
dashboardBody(
tabItems(
##----TabItem: Overview----
tabItem(tabName="overview",
fluidRow(
valueBoxOutput("A"),
valueBoxOutput("B")
)
),
###----TabItem:Pivot----
tabItem(tabName = "pivot",
##Pivot
column(6,offset=4,titlePanel("Daten-Explorer")),
column(12,
#mainPanel(
rpivotTableOutput("pivot")
#)
)
),
##----TabItem:Test----
tabItem(tabName = "farmer",
h2("In Progress"))
)
)
)
server <- function(input, output) {
##----server:overview----
output$A<-renderValueBox({
valueBox(
paste0(25, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
output$B<-renderValueBox({
valueBox(
paste0(55, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
##----server:pivot----
output$pivot <- renderRpivotTable({
rpivotTable(data = df)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am trying to build a r shiny app where the user will get to know about each function in just a click. For this I have coded below in R . But print(??input$A) is not working. Could anyone help please
library(shinydashboard)
library(readxl)
out <- data.frame(baseFns = ls('package:base'))
ui <- dashboardPage(
dashboardHeader(title = "Loading data"),
dashboardSidebar(sidebarMenu(
menuItem("Analysis", tabName = "Analysis", icon = icon("chart-bar"))
)),
dashboardBody(
tabItems(tabItem(tabName = "Analysis",
fluidRow(box(selectInput("A","A",choices = c(levels(factor(out$baseFns))),width = "150px"),width = 2),
fluidRow(box(htmlOutput("Text"),width = 9)))
)
))
)
server <- function(input,output){
output$Text <- renderText({
print(??input$A)
})
}
shinyApp(ui, server)
Here is a way:
library(shiny)
library(shinydashboard)
library(gbRd) # for Rd_fun
library(tools) # for Rd2HTML
out <- data.frame(baseFns = ls('package:base'))
ui <- dashboardPage(
dashboardHeader(title = "Loading data"),
dashboardSidebar(sidebarMenu(
menuItem("Analysis", tabName = "Analysis", icon = icon("chart-bar"))
)),
dashboardBody(
tabItems(
tabItem(
tabName = "Analysis",
fluidRow(
box(selectInput("A", "Topic", choices = levels(factor(out$baseFns)),
width = "150px"),
width = 2),
fluidRow(box(htmlOutput("helpfun"), width = 9))
)
)
))
)
server <- function(input, output, session){
output$helpfun <- renderUI({
Rd <- Rd_fun(help(input$A))
outfile <- tempfile(fileext = ".html")
Rd2HTML(Rd, outfile, package = "",
stages = c("install", "render"))
includeHTML(outfile)
})
}
shinyApp(ui, server)
how to render a box in shiny according to the data.
data is uploaded by user and it can have more data than this, so i have to create
a box dynamically.
i am running the below code and i am getting four box created in console not in shiny webpage.
please have a look, thankyou.
CODE
list_data <- list(c("AB","CD","EF","GH")) #data
ui <- dashboardPage(
dashboardHeader(title = "Text Mining"),
dashboardSidebar(
sidebarMenu(
menuItem("NLP Tree", tabName = "NLP")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "NLP",
fluidRow(
tabBox(width = 12,height="500",
tabPanel("Sentences",
uiOutput("nlp_sentences_tree")
)
)
)
)
)
)
)
server <- function(input, output) {
output$nlp_sentences_tree <- renderUI({
for(i in list_data[[1]]){
print(box(width = 8,
i
)
)
}
})
}
shinyApp(ui = ui, server = server)
Have a look here, I've added a button to each just so something is in there
library(shinydashboard)
library(shiny)
list_data <- list(c("AB","CD","EF","GH")) #data
ui <- dashboardPage(
dashboardHeader(title = "Text Mining"),
dashboardSidebar(
sidebarMenu(
menuItem("NLP Tree", tabName = "NLP")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "NLP",
fluidRow(
tabBox(width = 12,height="500",
tabPanel("Sentences",
uiOutput("nlp_sentences_tree")
)
)
)
)
)
)
)
server <- function(input, output) {
v <- list()
for (i in 1:length(list_data[[1]])){
v[[i]] <- box(width = 8, list_data[[1]][i],actionButton(i,i))
}
output$nlp_sentences_tree <- renderUI(v)
}
shinyApp(ui = ui, server = server)
Or with an lapply and tagList:
server <- function(input, output) {
output$nlp_sentences_tree <- renderUI({
a <- lapply(list_data[[1]], function(x) {
box(width = 8, x)
})
tagList(a)
})
}
I wish to know if it is possible to create multiple infoBoxes with only one reactive function "ibox" as in the script below. I shall pass the values for all the infoboxes below within the ibox reactive function and see all of them getting displayed together.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
infoBoxOutput("ibox")
)))
server <- function(input, output) {
output$ibox <- renderInfoBox({
infoBox(
"Title",
5,
icon = icon("credit-card")
)
infoBox(
"Title",
5,
icon = icon("credit-card")
)
infoBox(
"Title",
4,
icon = icon("credit-card")
)
})}
shinyApp(ui, server)
As mentioned in the comments, you could use renderUI and uiOutput. However, note that renderUI only actually renders the last statement in its body. In order to render multiple objects, we can place them in a list (or column, fluidRow, etc.). Working example:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
uiOutput("ibox")
)))
server <- function(input, output) {
output$ibox <- renderUI({
list(
infoBox(
"Title",
5,
icon = icon("credit-card")
),
infoBox(
"Title",
5,
icon = icon("credit-card")
),
infoBox(
"Title",
4,
icon = icon("credit-card")
)
)
})}
shinyApp(ui, server)
Is it possible to render the dashboard header dropdownmenu or a notificationitem based on a reactive object? My try didn't work.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(uiOutput("drop")),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) {
values<-reactiveValues()
values[["numvotes"]]<-1
output$drop<-renderUI({
dropdownMenu(type = "notifications", badgeStatus = "warning",
notificationItem(icon = icon("ok", lib = "glyphicon"), status = "danger",
paste(values[["numvotes"]],"vote(s)")
) )
})
}
shinyApp(ui, server)
Yes, this is explained in the documentation for shinydashboard with a renderMenu and dropdownMenuOutput:
https://rstudio.github.io/shinydashboard/structure.html#dynamic-content
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(dropdownMenuOutput("notif")),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) {
values<-reactiveValues()
values[["numvotes"]] <- 1
output$notif <- renderMenu({
dropdownMenu(type = "notifications", badgeStatus = "warning",
notificationItem(icon = icon("ok", lib = "glyphicon"), status = "danger",
paste(values[["numvotes"]], "vote(s)")
) )
})
}
shinyApp(ui, server)