I am trying to use shinyCAPTCHA package with shinydashboard, but it is not working correctly. What is the correct way to use it?
library(shiny)
library(shinydashboard)
library(shinyCAPTCHA)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput(outputId = "captcha"))
)
server <- function(input, output) {
result <- callModule(recaptcha, "test", secret = "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe")
output$captcha <- renderUI({
req(result()$success)
output$plot1 <- renderPlot({
set.seed(122);histdata <- rnorm(500)
hist(histdata[seq_len(input$slider)], main = "Histrogram", xlab = "x") })
fluidRow(
box(plotOutput("plot1", height = 250)),
box(title = "Controls",sliderInput("slider", "Number of observations:", 1, 100, 50)))
})
}
shinyApp(ui, server)
This is less bad I think
library(shiny)
library(shinydashboard)
library(shinyCAPTCHA)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput(outputId = "captcha"))
)
server <- function(input, output) {
result <- callModule(recaptcha, "test", secret = "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe")
output$captcha <- renderUI({
req(result()$success)
output$plot1 <- renderPlot({
set.seed(122);histdata <- rnorm(500)
req(reactive(input$slider)())
hist(histdata[seq_len(reactive(input$slider)())], main = "Histrogram", xlab = "x") })
fluidRow(
box(plotOutput("plot1", height = 250)),
box(title = "Controls",sliderInput("slider", "Number of observations:", 1, 100, 50)))
})
}
shinyApp(ui, server)
Related
My shiny app looks like this:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(plotOutput("plot1", height = 250)),
box(textInput("my_text", # supposed to be a numeric input
"Text input:"),
title = "Controls",
sliderInput("slider",
"Number of observations:",
min = 1, max = 100,
value = 50 # Want it to be output$my_init
)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
# My attempt
# output$my_init <- input$my_text + 28
}
shinyApp(ui, server)
I want to set the initial value of the slider as output$my_init, a numeric variable that will be the result of operating some input variables. I tried using renderPrint, but the output is not numeric.
Thanks in advance.
I piggybacked on #stefan's comments and came up with this answer:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(plotOutput("plot1", height = 250)),
box(numericInput("my_num", "Numeric input:", value = 50),
title = "Controls",
sliderInput("slider",
"Number of observations:",
min = 1, max = 100,
value = 50 # Want it to be output$my_init
)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
# My attempt
observeEvent(input$my_num, {
updateSliderInput(inputId = "slider", value = input$my_num)
})
}
shinyApp(ui, server)
The idea is to use observeEvent() to trigger updateSliderInput() (update slider input widget) and update the value parameter of sliderInput()
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)
Let's say that I have a shiny dashboard uses by default a vertical scroll bar because of a large plot in the right side but for some reason I do not want it there even if the plot is not displayed as a whole. I do not want to reduce the plot height as well.Can this be done?
## app.R ##
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 850)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
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 following css should do it : body {overflow-y: hidden;}
## app.R ##
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
"body {overflow-y: hidden;}"
)
),
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 850)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
I'm using R shiny Dashboard for data visualization in my case i wanted to insert user input into filtering data frame in r
library(shiny)
library(shinydashboard)
ui <-
dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
)
),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "",
sliderInput("slider", "Number of Breaks:", 1, 180, 50)
),
box(
selectInput('BILLING_CENTRE', 'Select Billing Center', names(dfList))
)
)
)
)
server <-
function(input, output) {
d <- read.csv('Events_for_Jan_suspensions.csv')
dfList <- split(d, d$BILLING_CENTRE)
abc <- reactive({input$BILLING_CENTRE})
if (abc == "AD"){
histdata <- dfList$AD$SU_TO_OK_DURATION
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.