I would like to reduce the font-size (ticks) in the sliderInput. The UI is too large. Anyone can give helps? Thanks
Simple example:
ui <- fluidPage(
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500
),
plotOutput("distPlot")
)
# Server logic
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs))
})
}
# Complete app with UI and server components
shinyApp(ui, server)
Best wishes,
hees
You can do this with CSS. Here I am modifying the property of the slider class, so if you have several sliderInput in your code, it will alter all of them.
ui <- fluidPage(
tags$head(
tags$style(HTML("
.irs-grid-text {
font-size: 6px;
}
.irs--shiny .irs-min,.irs--shiny .irs-max {
font-size: 6px;
}
.irs--shiny .irs-from,.irs--shiny .irs-to,.irs--shiny .irs-single {
font-size: 7px;
}
"))
),
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500
),
plotOutput("distPlot")
)
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs))
})
}
shinyApp(ui, server)
Related
I want the user to complete his email address to restore the password. I need the user to populate part of his email address in a inputText that is in the same line with the rest. I want something like this:
but this is what i get:
This is my code:
library(shiny)
ui <- fluidPage(
uiOutput("completeMailMessage")
,actionButton("Restore","Restore user")
)
server <- function(input, output, session) {
emailAddress<-"someone#gmail.com"
dotPosition<-tail(unlist(gregexpr("#", emailAddress)), n=1)
firstPart<-substr(emailAddress,1,1)
secondPart<-substr(emailAddress,2,dotPosition-2)
thirdPart<-substr(emailAddress,dotPosition-1,nchar(emailAddress))
observeEvent(input$Restore,{
emailAddress2<-paste0(firstPart,input$b,thirdPart)
print(emailAddress2)
})
output$completeMailMessage<-renderUI({
fluidRow(
tags$head(
tags$style(type="text/css","label{ display: table-cell; text-align: center;vertical-align: middle; } .form-group { display: table-row;}")
),
h4("Complete the email to restore the password:"),
div(style= " text-align: left;"
,tags$h5(firstPart)
,textInput(inputId = "b",
label = div(style = "font-size:10pX;", ""), value=secondPart,width = "200px")
,tags$h5(thirdPart)
)
)
})
}
shinyApp(ui = ui, server = server)
Any suggestion?
Thanks!
One solution:
library(shiny)
ui <- fluidPage(
uiOutput("completeMailMessage")
,actionButton("Restore","Restore user")
)
server <- function(input, output, session) {
emailAddress<-"someone#gmail.com"
dotPosition<-tail(unlist(gregexpr("#", emailAddress)), n=1)
firstPart<-substr(emailAddress,1,1)
secondPart<-substr(emailAddress,2,dotPosition-2)
thirdPart<-substr(emailAddress,dotPosition-1,nchar(emailAddress))
observeEvent(input$Restore,{
emailAddress2<-paste0(firstPart,input$b,thirdPart)
print(emailAddress2)
})
output$completeMailMessage<-renderUI({
fluidPage(
fluidRow(h4("Complete the email to restore the password:")),
fluidRow(
tags$head(
tags$style(HTML(
".form-control { height:auto; padding:1px 1px;}"
))
),
column(width = 1,
div(style = "white-space: nowrap;",
h5(firstPart,style="display:inline-block"),
div(style="display: inline-block; width: 100%;margin-left:0px",textInput("b", label = NULL, value = secondPart, width = 80)),
h5(thirdPart,style="display:inline-block")
)
)
)
)
})
}
shinyApp(ui = ui, server = server)
Is there a way to list the objects(dataframes, functions, args(funtions), inputs, outputs of a shiny app. In the below app, there are inputs likes actionButton(), numericInput() etc, and outputs like renderText(). Is there a way to list these along with there ID'd (eg action Button has "goButton") and so on.
Also, there is a function declared here called "asd" with arguments (3,4). Can we also list these information ? please guide
ui.R
source("fun.R")
pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
verbatimTextOutput("nText")
)
)
server.R
function(input, output) {
# builds a reactive expression that only invalidates
# when the value of input$goButton becomes out of date
# (i.e., when the button is pressed)
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderText({
asd(3,4)
})
}
fun.R
asd <- function(a,b)
{
c <- a + b
return(c)
}
You can use action buttons, show, hide from shinyjs and verbatimtextoutput to have show code for specific output in your app. Like this:
library(shiny)
library(shinyjs)
asd <- function(a,b)
{
c <- a + b
return(c)
}
ui <- pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
useShinyjs(),
tags$head(tags$style("
#nText {
color: #333;
background-color: #f5f5f5;
border-radius: 4px;');
}
pre {
font-size: 90%;
color: #c7254e;
border-radius: 4px;
}")),
verbatimTextOutput("nText"),
actionButton("showtextcode", "Show Code"),
verbatimTextOutput("textoutputcode"),
)
)
server <- function(input, output) {
# builds a reactive expression that only invalidates
# when the value of input$goButton becomes out of date
# (i.e., when the button is pressed)
shinyjs::hide("textoutputcode")
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderText({
asd(2,3)
})
output$textoutputcode <- renderText({
"output$nText <- renderText({
asd(2,3)
})"
})
observeEvent(input$showtextcode, {
if(input$showtextcode %% 2) {
shinyjs::show("textoutputcode")
} else {
shinyjs::hide("textoutputcode")
}
})
}
shinyApp(ui, server)
Result:
If you want to show all of your code for the app, you can create a separate tab that shows the full code placing everything in verbatimTextOutput. However, just because you can doesn't mean you should. For instance, if your shiny app spans 5000 lines then this is a bit silly!
It would be much better to simply include a github link to the source code of the app, if users are interested they can simply follow the link. Remember shiny is designed to share interactive output and not full source code.
The problem i am having is that i have to create an psychological online experiment. I won't get into all the details, however, one aspect involves displaying an image or plot for a set number of seconds. I have started learning Shiny and I am two hours into it, (as i am relatively good with R, and it seemed a good step) however i cannot find a way to do this.
I know showNotification has a "duration" attribute, but I found nothing for showPlot, or Image.
Is there a way to do this, or should I quit Shiny while I haven't lost much time?
Greetings,
George
EDIT: wow. more or less is what I want. Thank you all!
Since details were asked (and thank you for that), the experiment requires only one image. there will be two experimental conditions, and both will have one plot to show (that plot i intend to draw with ggplot2) and contains a number of 30-50 points for about 4 seconds. The subject will have to evaluate the number of points (since he can't count them) and insert it in a field, and the subject will have to then evaluate certain evaluation parameters. data that will be reused to compare him to others. that is about it!
Since it is now obviously possible to do this, i will begin with a serious approach to Shiny. Thank you all!
You will be able to do this in shiny.
You can use a reactiveTimer for example
if (interactive()) {
ui <- fluidPage(
plotOutput("plot")
)
server <- function(input, output) {
# every 2 seconds.
autoHide <- reactiveTimer(2000)
display <- TRUE
observe({
# re-execute this reactive expression every time the
# timer fires.
autoHide()
display <- if_else(display,FALSE,TRUE)
})
output$plot <- renderPlot({
autoHide()
if(display){
hist(rnorm(200))
} else {
hist(rnorm(100))
}
})
}
shinyApp(ui, server)
}
Here is a solution using the slick.js JavaScript library. You have to download the zip file here and extract it in the www subfolder of your app.
library(shiny)
# images to be displayed ####
## these images are in the www subfolder
images <- c("img1.JPG", "img2.JPG", "img3.JPG", "img4.JPG", "img5.JPG")
# ui #####
ui <- fluidPage(
tags$head(
tags$link(rel="stylesheet", type="text/css",
href="slick-1.8.1/slick/slick-theme.css"),
tags$link(rel="stylesheet", type="text/css",
href="slick-1.8.1/slick/slick.css"),
tags$script(type="text/javascript",
src="slick-1.8.1/slick/slick.js"),
tags$script(HTML(
"$(document).ready(function(){
$('#images').slick({
arrows: true,
dots: true,
slidesToShow: 1,
slidesToScroll: 1,
autoplay: true,
autoplaySpeed: 500,
infinite: false
}).on('afterChange', function(e, slick, cur){
if(cur === slick.$slides.length-1){
slick.setOption('autoplay', false, true);
}
});
});")),
tags$style(HTML(
"#images .slick-prev {
position:absolute;
top:65px;
left:-50px;
}
#images .slick-next {
position:absolute;
top:95px;
left:-50px;
}
.slick-prev:before, .slick-next:before {
color:red !important;
font-size: 30px;
}
.content {
margin: auto;
padding: 2px;
width: 90%;
}"))
),
sidebarLayout(
sidebarPanel(
# empty sidebar #
),
mainPanel(
tags$div(class="content",
do.call(function(...) tags$div(id="images", ...),
lapply(seq_along(images), function(i){
uiOutput(paste0("img",i))
})
)
)
)
)
)
# server #####
server <- function(input, output) {
lapply(seq_along(images), function(i){
output[[paste0("img",i)]] <- renderUI({
tags$img(src = images[i], width = "400px", height = "400px")
})
})
}
# Run the application ####
shinyApp(ui = ui, server = server)
Is it something like this you want ? We could try to add a "Go" button because here the autoplaying slideshow runs at the startup. Though this is not necessary: to stop the slideshow, it suffices to put the mouse cursor on the image.
EDIT
Here is the version with a "Go" button.
library(shiny)
# images to be displayed ####
## these images are in the www subfolder
images <- c("img1.JPG", "img2.JPG", "img3.JPG", "img4.JPG", "img5.JPG")
# ui #####
ui <- fluidPage(
tags$head(
tags$link(rel="stylesheet", type="text/css",
href="slick-1.8.1/slick/slick-theme.css"),
tags$link(rel="stylesheet", type="text/css",
href="slick-1.8.1/slick/slick.css"),
tags$script(type="text/javascript",
src="slick-1.8.1/slick/slick.js"),
tags$script(HTML(
"function runSlick(x){
$('#images').slick({
arrows: true,
dots: true,
slidesToShow: 1,
slidesToScroll: 1,
autoplay: true,
autoplaySpeed: 500,
infinite: false
}).on('afterChange', function(e, slick, cur){
if(cur === slick.$slides.length-1){
slick.setOption('autoplay', false, true);
}
});
};
Shiny.addCustomMessageHandler('runSlick', runSlick);")),
tags$style(HTML(
"#images .slick-prev {
position:absolute;
top:65px;
left:-50px;
}
#images .slick-next {
position:absolute;
top:95px;
left:-50px;
}
.slick-prev:before, .slick-next:before {
color:red !important;
font-size: 30px;
}
.content {
margin: auto;
padding: 2px;
width: 90%;
}"))
),
sidebarLayout(
sidebarPanel(
actionButton("go", "Go!")
),
mainPanel(
conditionalPanel(
"input.go > 0",
tags$div(class="content",
do.call(function(...) tags$div(id="images", ...),
lapply(seq_along(images), function(i){
uiOutput(paste0("img",i))
})
)
)
)
)
)
)
# server #####
server <- function(input, output, session){
lapply(seq_along(images), function(i){
output[[paste0("img",i)]] <- renderUI({
tags$img(src = images[i], width = "400px", height = "400px")
})
})
observeEvent(input[["go"]], {
session$sendCustomMessage("runSlick", "")
}, once = TRUE)
}
# Run the application ####
shinyApp(ui = ui, server = server)
I want to put a selectInput inside the dashboardHeaderPlus but this makes that the header extends itself out of bounds, messing even with the sidebar as it's shown in the image:
What it's intended to happen, is making the selectInput look like the Facebook search bar, which means centered without affecting the header and styled with a magnifying glass icon if it's possible. Just like this:
Image: Actual output / Intended output
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
MenuProfesor <- function(){
selectInput(inputId = "Search",
label = NULL,
selected = FALSE,
multiple = FALSE,
choices = c('1','2','3','4'))
}
header <- dashboardHeaderPlus(
title = 'Planificación UAI',
enable_rightsidebar = FALSE,
left_menu = tagList( MenuProfesor())
)
ui <- dashboardPage(
header,
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Does this work for you?:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
header <- dashboardHeaderPlus(
title = 'Planificación UAI',
tags$li(class = "dropdown",
tags$li(class = "dropdown", div(searchInput(
inputId = "search",
label = NULL,
placeholder = "Search...",
btnSearch = icon("search"),
btnReset = icon("remove"),
width = "100%"
), style= "width: 25%; margin-left: auto; margin-right: auto; margin-top:-43px; margin-bottom:-10px;"))),
enable_rightsidebar = FALSE,
fixed = TRUE
)
ui <- dashboardPage(
header,
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output, session) {}
shinyApp(ui, server)
Result:
Also you might want to check this related question.
I have a list object that I would like to update with a reactive input. The object has to be a list.
Below is my minimal code. Thanks in advance.
library(shiny)
shinyApp(
ui = fluidPage(
fluidRow(
numericInput("number", "Change number", 10, min = 1, max = 100),
verbatimTextOutput('show')
)
),
server = function(input, output, session) {
QG <- list(a = c(1:10),
b = LETTERS[1:10])
#How to update reactiveVal from reactive input
#QG$a[2] <- input$number
output$show <- renderPrint({
QG$a[2]
})
}
)
Something like this?
library(shiny)
QG <- list(a = c(1:10),b = LETTERS[1:10])
shinyApp(
ui = fluidPage(
fluidRow(
numericInput("number", "Change number", 10, min = 1, max = 100),
verbatimTextOutput('show')
)
),
server = function(input, output, session) {
Values <- reactive({
QG$a[2] <- as.numeric(input$number)
QG
})
output$show <- renderPrint({
Values()
})
}
)