Changing the language of "to" in Shiny's dateRangeInput - r

I'm very new to shiny or any dashboard related development for that matter. My question is kind of specific and only tackles how the data is displayed and does not talk about internal logic of the app.
I applied language = "ru" option inside dateRangeInput and it changed how the text within date selector is rendred but it did not change the "to" bettween the two datefields. I understand that it might sound like I'm nitpicking but these little details matter for what I'm trying to do. Screenshow to ilustrate the problem.
Thanks in advance!
ui <- fluidPage(
titlePanel("Калькулятор остатков"),
sidebarLayout(
sidebarPanel(
dateRangeInput("dates","Временной диапазон",start = "2020-07-01",
end = "2020-09-01", language = "ru"),
),
mainPanel()
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)

The function dataRangeInput has an seperator- argument, the default is to. You may change this to your desired word.
ui <- fluidPage(
titlePanel("Калькулятор остатков"),
sidebarLayout(
sidebarPanel(
dateRangeInput("dates",
"Временной диапазон",
start = "2020-07-01",
end = "2020-09-01",
language = "ru",
separator = " до "),
),
mainPanel()
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)

Related

R shiny code to get output which takes input from ui

I am trying to write a script in shiny, which has two inputs and stores the inputs in two different variables and runs a code using these input variables.But i am getting an error which says :Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
The following is my ui code:
ui <- fluidPage(
titlePanel("Network Model"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "origin",
label = "Origin:",
choices = milk_runs$Origin),
selectInput(inputId = "destination",
label = "Destination:",
choices = milk_runs$Dest),
actionButton("go", "")
),
mainPanel(
tableOutput(
"view"))
)
)
server code :
server<- function(input, output){
origin <- input$origin
destination <- input$destination
observeEvent(input$go,source("nr9.R"))
output$summary <- renderPrint({
#dataset <- datasetInput()
summary(Tnetwork)
})
Can you please tell me how to get correct results.
I think (it would help if you provided a fully reproducible example) that the error is occurring because you are trying to run input$origin without reactive(). The input$origin will not invalidate and update based on user input unless put inside reactive. Based on the example you provided:
library(shiny)
ui <- fluidPage(
titlePanel("Network Model"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "origin", label = "Origin:", choices = c("A","B","C","D","E","F")),
selectInput(inputId = "destination", label = "Destination:", choices = c("A","B","C","D","E","F")),
actionButton("go", "GO")
),
mainPanel( tableOutput( "view"))
)
)
server<- function(input, output){
origin <- reactive(input$origin)
destination<-reactive(input$destination)
observeEvent(input$go,{
cat(origin(),'nextword',destination(),sep="-")
})
output$view <- renderTable({data.frame(origin=origin(),destination=destination())})
}
shinyApp(ui, server)
should print 'origin-nextword-destination' to the console when 'go' is activated, and the table should update. I changed a few bits in your example because it was not reproducible but hopefully it helps.

shiny: dynamically change tab names

I'm working on a Shiny application that is supposed to handle multiple languages. I managed to dynamically translate almost all elements of the app depending on a selectInput to choose the language. However the "hard stuff" remains the navbarPage tabs as well as the tabPanels inside my pages. I cannot change their names. I tried this, but it does not work:
library(shiny)
ui <- navbarPage("App Title",
tabPanel("tab1",
selectInput("language", "language", c("EN", "FR"), width = '300px'),
textOutput("text")),
uiOutput("render_tab2"))
server <- function(input, output, session) {
output$text = renderText({ switch(input$language, "EN"="hello world", "FR"="bonjour monde") })
output$render_tab2 = renderUI({
tabPanel( title=switch(input$language, "EN"="tab2", "FR"="onglet2") )})}
shinyApp(ui, server)
And the updatenavbarpanel() family of functions are just to set the active tab, not change their characteristics...Is there a way to do it, if possible that does not change the structure of all my app... THanks a lot.
This piece of code set the title dynamically :
library(shiny)
ui <- navbarPage("App Title",
tabPanel(title = uiOutput("title_panel"),
selectInput("language", "language", c("EN", "FR"), width = '300px')
)
)
server <- function(input, output, session) {
output$title_panel = renderText({
switch(input$language, "EN"="hello world", "FR"="bonjour monde")
})
}
shinyApp(ui, server)
Edit : Works with both uiOutput("title_panel") & textOutput("title_panel")

How to stop restarting list in selectize input after click in Shiny?

When I filter a list of states in Shiny for: "New" I can choose only one state. After that the list is restarting and I have to put: "New" again in order to find a state contains "New" in name. I would like to filter states and choose more states at one time.
Below I added a picture and a code which present my goal.
Picture
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(
'e2', '2. Multi-select', choices = state.name, multiple = TRUE
)
),
mainPanel(
verbatimTextOutput('ex_out')
)
)
)
server <- function(input, output) {
output$ex_out <- renderPrint({
sapply(sprintf('e%d', 2), function(id) {
input[[id]]
})
})
}
shinyApp(ui = ui, server = server)

shiny object reactivity to several inputs (buttons)

I have a shinyapp, in which a main object should be updated depending on the change other objects/inputs (buttons that perform other operations, whose result is not easily tracked, e.g. online data). That's why I had to use the input of buttons. Is there a way to update the main object without having to re-write the code for every button? In my example, I had to use observeEvent two times:
library(datasets)
library(shiny)
ui<-fluidPage(
titlePanel("Telephones by region"),
sidebarLayout(
sidebarPanel(
selectInput("region", "Region:",
choices=colnames(WorldPhones)),
helpText("Data from AT&T (1961) The World's Telephones."),
actionButton("submit",
label = "submit"), # this also has other functions
actionButton("change",
label = "change") # this also has other functions
),
mainPanel(
plotOutput("phonePlot")
)
)
)
server<-function(input, output) {
data<-reactiveValues()
observeEvent(input$submit,{
data$data<-WorldPhones[,input$region]
})
observeEvent(input$change,{
data$data<-WorldPhones[,input$region]
})
output$phonePlot <- renderPlot({
if(!is.null(data$data))
barplot(data$data*1000,
ylab="Number of Telephones",
xlab="Year")
})
}
shinyApp(ui = ui, server = server)
You simply make an expression with both buttons, for example using c():
observeEvent(c(input$submit,input$change),{
data$data<-WorldPhones[,input$region]
})

How to print error message near UI elements in R shiny?

An example code:
ui.R
library(shiny)
shinyUI(
fluidRow(column(2, actionButton("add", "ADD details")),
fluidRow(uiOutput("ui"))
)
)
server.R
shinyServer(function(input, output,session){
observeEvent(
input$add,
output$ui <- renderUI({
isolate({
fluidRow(column(4, textInput("birthweight", label = "birth weight:", value = '')),
column(3, numericInput("height",label = "Height:",value='')),
column(2, actionButton("addnew", "ADD details to database"))
)
})
})
)
})
When the user enters the input to birthweight an error message should be displayed near the textInput box if it contains character data, similarly for numericInput Height. This must be displayed as soon as the user enters the data or when the user clicks the add details to database action button, but should be displayed as an error message near the textbox not in a pop up window.
Can this be done in R shiny?
The validate function is one options. Another options is use an extra UI to show a error message only if the textInput has a no-numeric value. In this case you can add you own CCS to the error message. Here is an example based on your code.
library(shiny)
ui <-shinyUI(
fluidRow(
column(2,
actionButton("add", "ADD details")),
fluidRow( uiOutput("ui"))
)
)
server <- shinyServer(function(input, output,session){
observeEvent( input$add,
output$ui <- renderUI({
isolate({
fluidRow(
column(4,
textInput("birthweight", label = "birth weight:", value = ''),
uiOutput("checkBirthweight")),
column(3,
numericInput("height",label = "Height:",value='')),
column(2,
actionButton("addnew", "ADD details to database"))
)
})
})
)
output$checkBirthweight <- renderUI({
if (nchar(input$birthweight) > 0 && is.na(as.numeric(input$birthweight)))
p("Error: birth weight must be numeric")
})
})
shinyApp(ui, server)
By the way, it is good idea to put your code as code in your questions, it will helps to others to identify the problem. You can find extra help about that at https://stackoverflow.com/editing-help
Also, I know that everybody has its own code style and I respect that, but I found these guidelines for coding in R very useful https://google.github.io/styleguide/Rguide.xml

Resources