I have a Shiny app with numerous numericInput fields. I would like a way to format the numericInput fields with commas separating every 10^3. For example, I want 5,000,000 instead of 5000000.
I can do this in R with the format and prettyNum functions. But I don't have a way to do this in Shiny.
This would be very helpful for the UI because it would work with percents, money, etc. Does anyone have any idea how to incorporate this into the numericInput field?
Thanks!
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
mainPanel(
numericInput("formatNumber",
"Number should be formatted, e.g."5,000,000",
value = 1000),
p(format(5000000.10, big.mark=",", big.interval=3L,
digits=0, scientific=F))
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
The shinyWidgets package has a great new function (added as of version 0.5.4, also a disclaimer, I added it via a pull request), autonumericInput that will allow you to do just this. It is based on the javascript library autonumeric. There are a lot of options to the function, but the documentation is extensive and for simple uses most can be ignored.
What you are trying to do can be accomplished as follows:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
h1("Autonumeric Input Example"),
shinyWidgets::autonumericInput(
inputId = "num",
label = "Enter a large number:",
value = 1000000,
currencySymbolPlacement = "p",
decimalPlaces = 2,
digitGroupSeparator = ",",
decimalCharacter = "."
),
verbatimTextOutput("res1")
)
server <- function(input, output) {
output$res1 <- renderText(input$num)
}
shinyApp(ui = ui, server = server)
This is especially nice because it provides as-you-type formatting, so that the user can easily know how big the number is as they put it in. I know from experience that it is a real pain to try to put large numbers into the base shiny numericInput, trying to count digits in a small little box and figure out how many zeros there are. The goal of this function is to make formatting numeric inputs much easier.
Hopefully this is useful!
I could not find anything that would help with numericInput(), but here's what works with textInput() instead.
library(shiny)
if(interactive()){
shinyApp(
ui <- fluidPage(
mainPanel(
textInput("formatNumber1", "Number should be formatted, e.g.5,000,000", value = 1000),
textInput("formatNumber2", "Number should be formatted, e.g.5,000,000", value = 1000)
)
),
server <- function(input, output, session) {
observe({
updateTextInput(session, "formatNumber1", "Number should be formatted, e.g.5,000,000",
value = prettyNum(input$formatNumber1, big.mark=",", scientific=FALSE))
updateTextInput(session, "formatNumber2", "Number should be formatted, e.g.5,000,000",
value = prettyNum(input$formatNumber2, big.mark=",", scientific=FALSE))
})
}
)
}
That is the only method I found, however if you're too slow or add a digit after the commas have been added, the number is not displayed properly (e.g., 3,000 becomes 3,0,000 if you add a 0 at the end of the string). To correct that, I've changed the updateTextInput() function as below:
updateTextInput(
session,
"formatNumber1",
"Number should be formatted, e.g.5,000,000",
value = prettyNum(
gsub(",", "", input$formatNumber1),
big.mark=",", scientific=FALSE
)
)
In effect gsub() function is used to reset the input to a number every time the input is amended, otherwise the prettyNum() function is only using the digits after the comma and ignoring all digits on the left of the last comma.
If you've got multiple inputs to reformat, then create a function as follows (NB: I've also added req(input[[x]]) to avoid NA appearing when the input is blank):
updatetoprettynb <- function(x) {
req(input[[x]])
updateTextInput(
session,
x,
value = prettyNum(
gsub(",", "", input[[x]]),
big.mark = ",",
scientific = FALSE
)
)
}
You still have to use the function in a similar fashion but don't forget to use "":
observe({
updatetoprettynb("formatNumber1")
})
Related
I am trying to write an input page that takes the date of a section's last training, then calculates the currency of that training (how many days since), but I seem to be having a problem accessing the date from the dateInput element. I'm currently just trying to get it to print, but it is eluding me. Is there something I'm missing, or how can I get this to work? I've commented out the code to (hopefully) calculate the date gap, as I haven't had a date to work through that just yet. If you see an issue there, I'd appreciate that pointer as well.
Thank you!
library(shiny)
ui <- fluidPage(
tags$h3("Section Training"),
dateInput("section_Last_Training",
"When was your last training course?",
daysofweekdisabled = c(0, 6),
max = Sys.Date()
),
)
server <- function(input, output, session) {
section_Last_Training <- reactive({
# dateGap = as.character(difftime(Sys.time(), input$section_Last_Training, units = "days"))
print(input$section_Last_Training)
})
}
shinyApp(ui, server)
It is working, just make sure the last value in reactive is the value you want to assign to the reactive. You can do print, but do it before your gap calculation. Another thing is reactive is "lazily" evaluated. It means if there is no downstream reactivity requires it, it will not be calculated. So you need to add some events that require this reactive to make it work. See the code below.
library(shiny)
ui <- fluidPage(
tags$h3("Section Training"),
dateInput("section_Last_Training",
"When was your last training course?",
daysofweekdisabled = c(0, 6),
max = Sys.Date()
),
)
server <- function(input, output, session) {
section_Last_Training <- reactive({
print(input$section_Last_Training)
as.character(difftime(Sys.time(), input$section_Last_Training, units = "days"))
})
observe(print(section_Last_Training()))
}
shinyApp(ui, server)
I started to learn R Shiny recently and I tried to build an shiny app and failed. My problem is: I try to use local csv file on my computer and run simple look up using the custom function, like type in the student's name and return his/her student ID. The following is my codes:
ui.R
library(shiny)
shinyUI(fluidPage(
# application title
titlePanel("FGMC Search Engine"),
sidebarLayout(
sidebarPanel(
textInput("text",label = h3("Correspondent Search"), value = "Enter Here...")
),
mainPanel(
textOutput("text1")
)
)
))
and then
server.R
library(shiny)
# define function for inputing the corr array & input and return channel source
corr_search <- function(corr,input_name){
# lowercase of input names
name_lower = tolower(input_name)
# lowercase of corr names
corr_lowercase = substr(tolower(corr$TPO.Company.Name),1,nchar(test_lowercase))
# look up the corresponding channel source accounding to matched corr indexing
result = corr$Channel.Source[match(test_lowercase, corr_lowercase)]
# check if search result is Null
if (is.na(result)){
result = "Wrong Input! Please Search Again"
}
# return search result
return(result)
}
shinyServer(
function(input, output) {
textInput <- reactive({
corr = read.csv("C:\\Users\\carl.qin\\Desktop\\Projects\\Modelling & Analytics\\R Modelling\\App-2\\fgmc_correspondent.csv",header=TRUE)
input_name = input$text
If(is.na(input_name)){
input_name = "nothing"
}
})
result = corr_search(corr,input_name)
output$text1 <- renderPrint({
result
})
}
)
I keep getting the error: Object not found. It would be great if someone could help solve this problem.
Thank you!
In the function corr_search you use a variable test_lowercase which is nowhere defined (doesn't exist and hence an error). In reactive you use if-statement but you have a typo. (Instead of If you should have if). You should also move result = corr_search(corr, input_name) to the reactive expression textInput (where you have defined input_name) and return a value which you finally pass to renderPrint via textInput()
I'm trying to use shiny to create a bar graph for a state that is selected via drop-down box. I'm quite new to R and I've tried a variety of examples to no avail. I have three variables (state, claim #, total $) and for each state there are five values. So something like this:
state <- c("PA", "TX", "NY")
claim_num <- c(1:15)
total <- sample(1000:5000, 15)
df <- (state, claim_num, total)
I want to have something similar to https://beta.rstudioconnect.com/jjallaire/shiny-embedding/#inline-app but I don't know if I can format my data in that was since I would have a lot of NAs.
Do you mean something like this (you can download and run the example)?
library(shiny)
ui <- shinyUI(
fluidPage(
titlePanel("Sample Shiny App"),
sidebarLayout(
sidebarPanel(
uiOutput("stateInput")
),
mainPanel(
plotOutput("statePlot")
)
)
))
server <- shinyServer(function(input, output) {
state <- sample(state.abb, 3, replace = FALSE)
total <- sample(1000:5000, 15)
claimNumber <- 1:15
data <- data.frame(state, total, claimNumber)
output$stateInput <- renderUI({
selectInput(
inputId = "state",
label = "Select a State:",
choices = levels(data$state)
)
})
output$statePlot <- renderPlot({
hist(data$total[data$state == input$state])
})
})
shinyApp(ui = ui, server = server)
What we're doing is taking the list of unique states available in our data frame and passing those to our selectInput that renders as a dropdown in the UI. From here, we can access whatever value the user has selected through the input$state object. More generally, we can access inputs based on whatever we define the inputId to be (in this particular case, we call it state).
Having grabbed the user input, we can then subset the data frame to only return values that correspond to the user-defined state and, in this case, pass those totals values to a plot that we render as output.
I am producing a Shiny App that produces a leaflet (rCharts) map depending on which bus route you pick. Everything renders perfectly at first glimpse, but if you change the route number, an empty map appears (not even a tilelayer). This isn't specific to the route number. For example, I can pick any route number to produce the first plot successfully, whereas the second plot, regardless of route number, is blank.
Has anyone come across this before? Is there a workaround?
Here is a simple example.
ui.R:
library(shiny)
library(rCharts)
shinyUI(fluidPage(
titlePanel("Responsive Leaflet Map using rCharts"),
sidebarLayout(
sidebarPanel( "",
selectInput(
'route', 'Pick a bus route:',
choices = as.character(c("232","229"),
selectize = FALSE)
)
),
mainPanel("",
chartOutput('map', 'leaflet')
)
)
))
server.R:
library(shiny)
library(rCharts)
library(RJSONIO)
library(rgdal)
shinyServer(function(input, output) {
output$map <- renderMap({
filename <- paste('json/',input$route,'.geojson',sep='')
json <- fromJSON(file = filename)
map3 <- Leaflet$new()
map3$tileLayer(provide='Esri.WorldTopoMap')
map3$setView(c(49.2494,-122.9797), zoom = 10)
map3$set(dom = 'map')
map3$fullScreen(TRUE)
map3$geoJson(
json,
style = "#!
{color: '#c93312'}!#")
map3
})
})
Thanks so much for any help you are able to provide.
C
The trick is to remove map3$set(dom = 'map'). Problem solved!
I developed a Shiny App with RStudio that takes input, performs a search of a look-up table, and then returns a value. The search is not supposed to be performed until the user hits the submit button. However, upon launch, the App automatically performs and returns the first set of values from the lookup table. After this initial search, the app works exactly as expected. Is it possible to suppress this initial search (or have a default value) and perform the search ONLY when the submit button is pressed? I can't present reproducible code, but here is the structure of my input (server.R) and my user-interface (ui.R) code:
#server.R snippet
output$Word <- renderText({
predictWord <- input$gram
predict.function(predictWord) #User-defined function in global.r file
})
#ui.R snippet
tabPanel("Word Prediction",
sidebarPanel(
textInput("gram", "Enter up to three words"),
submitButton("Predict")),
mainPanel(
h4("Word Prediction"),
textOutput("predictWord")))
One way would be to substitute actionButton in place of submitButton and wrap whichever component in an if statement. Here is a simple example to display a number only slightly modified from the Shiny Widget Gallery.
require(shiny)
runApp(list(
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(
verbatimTextOutput("nText")
)
),
server = function(input, output){
output$nText <- renderText({
# Take a dependency on input$goButton
if(input$goButton >= 1){
# Use isolate() to avoid dependency on input$n
isolate(input$n)
}
})
}
)
)