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)
Related
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)
Is there a way to trigger the tab only when the user clicks on action button . Example shown below. So tab2 is hidden, but when the user clicks on action button, the tab should pop up
library(shiny)
ui <- fluidPage(
tabsetPanel(id = "tabs",
tabPanel(value = "tab1", title = "Tab 1",
tableOutput("myTable"),
actionButton("sub","Submit")
),
uiOutput("show_tab1")
# tabPanel(value = "tab2", title = "Tab 2",
# plotOutput("myPlot")
# )
)
)
server <- function(input, output, session) {
observeEvent(input$sub,{
output$show_tab1 <- renderUI({
tabPanel(value = "tab2", title = "Tab 2",
plotOutput("myPlot")
)
})
})
}
shinyApp(ui, server)
Maybe this:
library(shiny)
ui <- fluidPage(
tabsetPanel(id = "tabs",
tabPanel(value = "tab1", title = "Tab 1",
tableOutput("myTable"),
actionButton("sub","Submit")
),
tabPanel(value = "tab2", title = "Tab 2",plotOutput("myPlot"))
)
)
server <- function(input, output, session) {
observe({
hideTab(inputId = "tabs", target = "tab2")
})
observeEvent(input$sub,{
showTab(inputId = "tabs", target = "tab2")
})
}
shinyApp(ui, server)
I have below app using multiInput() from shinyWidgets package
library(shinyWidgets)
library(shiny)
ui <- fluidPage(
div(style = "height: 200px;",
tags$head(
tags$style(".multi-wrapper {height: 90%;}"),
tags$style(".multi-wrapper .non-selected-wrapper, .multi-wrapper .selected-wrapper {height: 100%;}")
),
div(style = "height: 100%; background-color: rgba(0,0,0,.3);",
multiInput(
inputId = "id", label = "Fruits :",
choices = c("Banana", "Blueberry", "Cherry",
"Coconut", "Grapefruit", "Kiwi",
"Lemon", "Lime", "Mango", "Orange",
"Papaya"),
selected = "Banana", width = "400px",
options = list(
enable_search = FALSE,
non_selected_header = "Choose between:",
selected_header = "You have selected:"
)
)
)),
verbatimTextOutput(outputId = "res")
)
server <- function(input, output, session) {
output$res <- renderPrint({
input$id
})
}
shinyApp(ui = ui, server = server)
I want multiInput() should occupy entire height of parent Div which is not the case here. Any idea how to achieve this would be helpful
This seems to work:
library(shinyWidgets)
library(shiny)
ui <- fluidPage(
tags$head(
tags$style(".multi-wrapper {height: 350px;}"), # 350 = 400-50 (400 is the height of the div)
tags$style(".multi-wrapper .non-selected-wrapper, .multi-wrapper .selected-wrapper {height: 100%;}")
),
div(style = "height: 400px",
multiInput(
inputId = "id", label = "Fruits :",
choices = c("Banana", "Blueberry", "Cherry",
"Coconut", "Grapefruit", "Kiwi",
"Lemon", "Lime", "Mango", "Orange",
"Papaya"),
selected = "Banana", width = "400px",
options = list(
enable_search = FALSE,
non_selected_header = "Choose between:",
selected_header = "You have selected:"
)
)
),
verbatimTextOutput(outputId = "res")
)
server <- function(input, output, session) {
output$res <- renderPrint({
input$id
})
}
shinyApp(ui = ui, server = server)
I have below app using shinyWidgets package
library(shinyWidgets); library("shiny")
ui <- fluidPage(
multiInput(
inputId = "id", label = "Fruits :",
choices = c("Banana", "Blueberry", "Cherry",
"Coconut", "Grapefruit", "Kiwi",
"Lemon", "Lime", "Mango", "Orange",
"Papaya"),
selected = "Banana", width = "400px",
options = list(
enable_search = FALSE,
non_selected_header = "Choose between:",
selected_header = "You have selected:"
)
),
verbatimTextOutput(outputId = "res")
)
server <- function(input, output, session) {
output$res <- renderPrint({
input$id
})
}
shinyApp(ui = ui, server = server)
Is it possible to customize this further. Particularly I want to change the font color to Black for all choices. I added below line, however it failed to change the font color
tags$head(tags$style(HTML('#id {color:#000 !important;}'))),
Any pointer will be highly appreciated.
Use this CSS:
css <- "#id+div div a {color: black;}"
ui <- fluidPage(
tags$head(tags$style(css)),
......
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.