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)
Related
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")
),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
# Boxes need to be put in a row (or column)
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
),
# Second tab content
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
The above example, the output renders when the tabs dashboard and widgets are clicked seperately. In the dashboard tab, i have my slider input in the body.
Now when I change my slider to have it at the sidebar:
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui = dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
id = "sidebarmenu",
menuItem("menuItem1",
tabName = "tab1",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
,
menuItem("menuItem2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
tableOutput("myTable"),
),
tabItem(tabName = "tab2",
h2("Placeholder Cloud"),
plotOutput("myPlot"))
)
)
)
server <- function(input, output, session) {
tableData = reactiveVal(data.frame(x = 1:10, y = LETTERS[1:10]))
plotData = reactiveVal()
observeEvent(input$sidebarmenu, {
if(input$sidebarmenu == "tab2"){
#Code for tab 2
req(is.null(plotData()))
print("Tab 2 code is run")
plotData(runif(100))
}
})
output$myTable = renderTable({
tableData()
})
set.seed(122)
histdata <- rnorm(500)
output$myPlot = renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
Problem here:
1) The text placeholder cloud, initially only rendered when the tab menuItem2 is clicked, now gets rendered together with the histogram which was supposed to render only when i clicked menuItem1
2) clicking on menuItem2 does not do anything. I would like to have tab2 when clicked, show a scatterplot as seen in this below block of code.
i.e., i would like to "integrate the below 3rd block of code" into the 2nd, the above so when i run the second block of code, when i click tab1, the input for the slider appears and renders the histogram. when i click tab2, the scatterplot will be rendered
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui = dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
id = "sidebarmenu",
menuItem("menuItem1",
tabName = "tab1")
,
menuItem("menuItem2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
tableOutput("myTable")),
tabItem(tabName = "tab2",
h2("Placeholder Cloud"),
plotOutput("myPlot"))
)
)
)
server <- function(input, output, session) {
tableData = reactiveVal(data.frame(x = 1:10, y = LETTERS[1:10]))
plotData = reactiveVal()
observeEvent(input$sidebarmenu, {
if(input$sidebarmenu == "tab2"){
#Code for tab 2
req(is.null(plotData()))
print("Tab 2 code is run")
plotData(runif(100))
}
})
output$myTable = renderTable({
tableData()
})
output$myPlot = renderPlot({
plot(plotData())
})
}
shinyApp(ui, server)
Any help is appreciated.I am new to Shiny.
for your 2nd part you said "clicking on menuItem2 does not do anything."... but you don't have any action for menuItem2 see
menuItem("menuItem2", tabName = "tab2")
I created the main dashboard already in R using the shinydashboard package. However, my main question is how do I upload an Excel Csv file (which contains all the data) into the dashboard? I have been trying to figure this out and I am having trouble. So far, I have the following script:
install.packages("shinydashboard")
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Analysis Project"),
dashboardSidebar(
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Filter Page"),
menuItem("Data")
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard")
)
)
)
server <- function(input,output) { }
shinyApp(ui, server)
How about doing it this way?
library(shiny)
library(readxl)
ui <- fluidPage(
fileInput('file1', 'Insert File', accept = c(".xlsx")),
textInput('file1sheet','Name of Sheet (Case-Sensitive)'),
tableOutput("value")
)
server <- function(input, output) {
sheets_name <- reactive({
if (!is.null(input$file1)) {
return(excel_sheets(path = input$file1$datapath))
} else {
return(NULL)
}
})
output$value <- renderTable({
if (!is.null(input$file1) &&
(input$file1sheet %in% sheets_name())) {
return(read_excel(input$file1$datapath,
sheet = input$file1sheet))
} else {
return(NULL)
}
})
}
shinyApp(ui, server)
Try to make a code like that !
library(shiny)
library(shinydashboard)
header <- dashboardHeader(
title = "Analysis Project"
)
sidebar <- dashboardSidebar(
menuItem(text = "Importing file", tabName = "dashboard",icon = icon("file"),
menuSubItem(text = "Importing file", tabName = "dataset")
),
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Filter Page"),
menuItem("Data")
)
body <- dashboardBody(
fluidPage(
tabItems(
tabItem(tabName = "dataset",
fluidRow(
box(width = 12,
fileInput(inputId = "file",
label = "Choose a file",
accept = c(".xlsx",".csv")
),
tableOutput(outputId = "Contents"),
verbatimTextOutput(outputId = "Data")
)
)
)
)
)
)
ui <- dashboardPage(header = header,
sidebar = sidebar,
body = body)
server <- function(input, output, session) {
output$Data <- renderPrint({
if(is.null(input$file)){
print("Import Excel data file")
} else {
inFile <- input$file
df <- read_excel(inFile$datapath)
print(df)
}
})
}
shinyApp(ui = ui, server = 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)
})
}
library(shiny)
library(shinydashboard)
ui <- dashboardPage( skin="blue",title = "asdfasf",
dashboardHeader(title = "Fund Analysis Status Tool",titleWidth=255, .list=NULL),
dashboardSidebar( width = 255, sidebarMenu(menuItem("Analysis", icon = icon("th"),menuSubItem("ME-1", tabName = "Analysis-ME-1"),
menuSubItem("Current", tabName = "Analysis-Current")),menuItem("Post-Analysis1",icon = icon("th"),menuSubItem("ME-1", tabName = "Post_Analysis-ME-1"),menuSubItem("Current", tabName = "Post_Analysis-Current")))), # it gives heading in the left panel
dashboardBody(
tabItems(tabItem(tabName = "Analysis-ME-1",fluidRow(box(dataTableOutput('table')),box(title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)))),
tabItem(tabName = "Analysis-Current",h2("To be discussed1")),
# Second tab content
tabItem(tabName = "Post_Analysis-ME-1", h2("To be discussed1")),
tabItem(tabName = "Post_Analysis-Current",h2("To be discussed2")))))
server <- function(input, output) {
histdata <- rnorm(500)
output$table <- renderDataTable(iris)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
This is largely a matter of opinion on how you go about this. I've reorganized your code to how I might approach it below.
In the few applications I've built, my choice of strategy has varied by how large the application is. In smaller applications, I'll source in functions or define them in global.R and then use those functions throughout the application. More recently, I've started just writing each application as a stand alone package.
Either way, the general process is to break your application into small steps, write each of those steps into a function with a descriptive name (brevity isn't necessarily a virtue here), and then call the functions to generate your application.
library(shiny)
library(shinydashboard)
#* Put these in your global.R file, perhaps.
dashboard_header <- function(){
dashboardHeader(
title = "Fund Analysis Status Tool",
titleWidth=255,
.list=NULL
)
}
dashboard_sidebar <- function(){
dashboardSidebar(
width = 255,
sidebarMenu(
menuItem("Analysis", icon = icon("th"),
menuSubItem(
"ME-1",
tabName = "Analysis-ME-1"
),
menuSubItem(
"Current",
tabName = "Analysis-Current"
)
),
menuItem(
"Post-Analysis1",
icon = icon("th"),
menuSubItem(
"ME-1",
tabName = "Post_Analysis-ME-1"
),
menuSubItem(
"Current",
tabName = "Post_Analysis-Current"
)
)
)
)
}
tab_items <- function(){
tabItems(
# First tab content
tabItem(
tabName = "Analysis-ME-1",
fluidRow(
box( dataTableOutput('table') )
),
box(
title = "Controls",
sliderInput(
"slider",
"Number of observations:",
1,
100,
50
)
)
),
tabItem(
tabName = "Analysis-Current",
h2("To be discussed1")
),
# Second tab content
tabItem(
tabName = "Post_Analysis-ME-1",
h2("To be discussed1")
),
tabItem(
tabName = "Post_Analysis-Current",
h2("To be discussed2")
)
)
}
#***************************
#***************************
#* And now the ui and server
ui <-
dashboardPage(
skin="blue",
title = "asdfasf",
dashboard_header(),
dashboard_sidebar(),# it gives heading in the left panel
dashboardBody(
tab_items()
)
)
server <- shinyServer(function(input, output) {
histdata <- rnorm(500)
output$table <- renderDataTable(iris)
output$plot1 <- renderPlot({ data <- histdata[seq_len(input$slider)]
hist(data) })
})
shinyApp(ui, server)
I am using the following dataset: https://docs.google.com/spreadsheets/d/1C_P5xxzYr7HOkaZFfFiDhanqDSuSIrd2UkiC-6_G2q0/edit#gid=0
I am using ShinyDashboard and I have a selectInput that allows me to choose a specific type of Candy bar (in the Candy column in my data set).
How do I take that Candy selection, and then make a graph that contains the frequency for that selected candy bar for each purchase month? In my server.R, I am not sure what to have in that CandyCount reactive element.
My code is as follows:
## ui.R ##
library(shinydashboard)
library(rCharts)
dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
width = 150,
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("bar-chart"))
)
),
dashboardBody(
sidebarPanel(
htmlOutput("candy")
),
mainPanel(
showOutput("plot2", "polycharts")
)))
##server.R##
server <- function(input, output, session) {
output$candy<- renderUI({
selectInput(
inputId = "candy",
label = "Candy: ",
choices = as.character(unique(dataset$Candy)),
selected = "Twix"
)
})
output$plot2 <- renderChart2({
candySelect<- input$candy
df <- dataset[dataset$candy == candySelect,]
p2 <- rPlot(freq~purchase_month, data = df, type = 'line')
p2$guides(y = list(min = 0, title = ""))
p2$guides(y = list(title = ""))
p2$addParams(height = 300, dom = 'chart2')
return(p2)
})
}
If your okay with using ggplot you could do something like this:
Edited to have dynamic tooltip
## ui.R ##
library(shinydashboard)
library(shinyBS)
require(ggplot2)
dataset <- read.csv("Sample Dataset - Sheet1.csv")
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
width = 150,
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("bar-chart"))
)
),
dashboardBody(
sidebarPanel(
htmlOutput("candy")
),
mainPanel(
uiOutput("plotUI")
)
))
##server.R##
server <- function(input, output, session) {
output$candy<- renderUI({
selectInput(
inputId = "candy",
label = "Candy: ",
choices = as.character(unique(dataset$Candy)),
selected = "Twix"
)
})
output$plotUI <- renderUI({
if(is.null(input$candy)) return(NULL)
local({
candySelect <- input$candy
str1 <- sprintf("The candybar you selected is: %s",candySelect)
str2 <- sprintf("More about %s <a>here</a>",candySelect)
print (str1)
popify(plotOutput('plot'),str1,str2)
})
})
observeEvent(input$candy,{
if(is.null(input$candy)) return(NULL)
candySelect<- input$candy
print ('plot')
# Assuming only one entry for each mont per candybar
d <- dataset[dataset$Candy==candySelect,]
output$plot <- renderPlot({
ggplot(data=d, aes(x=purchase_month,y=freq,group=Candy)) +
geom_line() +
ggtitle(candySelect)
})
})
}
shinyApp(ui = ui, server = server)
I guess this should work otherwise you can bind tooltips using jQuery.