I am trying to call(source) a code based on user input date(to decide path), but can't get to execute this. There's no error, but the called(sourced) code doesn't work(I know this since no file is output). I think I am not able to use eventReactive correctly to get the code executed in following -
ui = fluidPage(
sidebarLayout(
sidebarPanel(
titlePanel("MY Outputs")
,dateInput("ME_DATE_output",label=h2("Execution Date"), value="2020-05-29")
,textOutput('dateSelectionStatement')
,hr()
,actionButton("calculate", "Calculate Again" )
,textOutput("success")
)))
server = function(input, output) {
ME_DATE_GUI <- reactive({input$ME_DATE_output})
output$dateSelectionStatement <- renderText({paste0('You have selected: ', ME_DATE_GUI()) })
Code_loc <- "K:/Codes/"
code_execution <- eventReactive(input$calculate, {source(paste0(Code_loc,"GUI_trials.r"))})
# Print a message for refresh
output$success <- renderText({paste0('Output refreshed for date - ', ME_DATE_GUI())})
}
shinyApp(ui, server)
GUI_trials look like -
# Use GUI Reactive to get the date
ME_DATE <- as.Date(ME_DATE_GUI(), format="%Y-%m-%d")
year_N_ME_DATE <- format(ME_DATE,"%Y")
month_N_ME_DATE <- format(ME_DATE,"%m")
month_T_ME_DATE <- months(ME_DATE)
# Location for Outputs
Output_DIR <- "K:/Outputs/"
Output_loc <- paste(Output_DIR,month_N_ME_DATE,". ",month_T_ME_DATE, " ",year_N_ME_DATE,"/",sep="")
success <- "Success"
write.csv(success, paste0(Output_loc,"Success.csv"))
The 2 problems are -
ME_DATE_GUI is not identified in sourced code(GUI_trials.r). Eeven if I use ME_DATE <<- renderText({input$ME_DATE_output}) in server part and place ME_DATE <- as.Date(ME_DATE, format="%Y-%m-%d") in GUI_trials.r, it's not working. The error is Error in as.Date.default: do not know how to convert 'ME_DATE' to class “Date”
eventReactive doesn't seem to do anything, i.e., actionButton part is inactive for me.
Any help is deeply appreciated!
server function as -
server = function(input, output) {
ME_DATE_GUI <- reactive({input$ME_DATE_output})
output$dateSelectionStatement <- renderText({paste0('You have selected: ', ME_DATE_GUI()) })
Code_loc <- "K:/Codes/"
observeEvent(input$calculate, {
ME_DATE <- ME_DATE_GUI()
source(paste0(Code_loc,"GUI_trials2.r"), local = TRUE)
# Print a message for refresh
output$success <- renderText({paste0('Output refreshed for date - ', ME_DATE_GUI())})
})
}
followed by change in GUI_trials2.R code as -
# Use ME_DATE from Shiny
ME_DATE <- as.Date(ME_DATE, format="%Y-%m-%d")
solved this issue!
Key was to use local=TRUE in source statement.
Related
Is there a way that we can pass Shiny objects to embedded or outside R script? Like if I create a dateInput(let's say, ME_DATE) in ui and try to pass it in a sourced code later in server, how can it be done?
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
dateInput("ME_DATE_output",label=h2("Execution Date"), value="2020-05-29")
)))
server = function(input, output) {
ME_DATE_GUI <- reactive({input$ME_DATE_output})
Code_loc <- "K:/Codes/"
ME_DATE <<- renderPrint({ ME_DATE_GUI() })
source(paste0(Code_loc,"Passed_R_code.r"))
}
And that Passed_R_code.R starts with -
ME_DATE <- as.Date(ME_DATE, format="%Y-%m-%d")
I also tried as.character in it.
The error I get is -
Error in as.Date.default: do not know how to convert 'ME_DATE' to class “Date”
Clearly passed ME_DATE isn't taking a value in YYYY-MM-DD format but some function. I am hoping there might be a step/function to convert this.
Any help is appreciated?
I made the mistakes of not assigning ME_DATE in reactive and then not declaring source as local = TRUE-
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
dateInput("ME_DATE_output",label=h2("Execution Date"), value="2020-05-29")
)))
server = function(input, output) {
ME_DATE_GUI <- reactive({ME_DATE <-input$ME_DATE_output})
Code_loc <- "K:/Codes/"
source(paste0(Code_loc,"Passed_R_code.r"),local=TRUE)
}
I noticed the answer here - https://stackoverflow.com/a/54572066/6877763
i have a question regarding Shiny and the usage of Data frames.
I think i understood that i need to create isolated or reactive environmentes to interact with, but if i try to work with the Dataframe i get an error message:
Error in pfData: konnte Funktion "pfData" nicht finden
i tried to manipulate the dataframe by this code:
server <- function(input, output) {
observeEvent(input$go,
{
pf_name <- reactive({input$pfID})
pf_date <- reactive({input$pfDate})
if (pf_name()!="please select a PF") {
pfData <- reactive(read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=","))
MDur <- pfData()[1,15]
pfData <- pfData()[3:nrow(pfData()),]
Total = sum(pfData()$Eco.Exp...Value.long)
}
})
}
If i manipulate my Dataframe in the console it works just fine:
pfData <- pfData[3:nrow(pfData),]
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
can you help me?
Edit:
library(shiny)
ui <- fluidPage(
fluidRow(
column(6, offset =3,
wellPanel(
"Choose Mandate and Date",
fluidRow(
column(4,selectInput("pfID",label = "",
choices = list("please select a PF","GF25",
"FPM"),
selected = "please select a PF") ),
column(4, dateInput("pfDate",label="",value = Sys.Date()) ),
column(2, actionButton("go","Submit")),column(2,textOutput("selected_var"))
)
)
)
)
)
# Define server logic ----
server <- function(input, output) {
pfDataReactive <- reactive({
input$go
if (pf_name()!="please select a PF") {
pfData <- read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=",")
MDur <- pfData[1,15]
pfData <- pfData[3:nrow(pfData),]
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
pfData
output$selected_var <- renderText({paste(MDur)})
}
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Thank you
Stefan
Without a working example, it's imposible to be sure what you're trying to do, but it sounds like you need a reactive rather than using observeEvent.
Try something like
pfDataReactive <- reactive({
input$go
pfData <- read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=",")
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
pfData
})
And then use pfDataReactive() in your Shiny app's server function wherever you would refer to pfData in your console code.
The standalone reference to input$go ensures the reactive will update whenever input$go changes/is clicked/etc.
Update
There are still significant issues with your code. You've added an assignment to an output object as the last line of the reactive I gave you, so the reactive always returns NULL. That's not helpful and is one of the reasons why it "doesn't active at all"...
Second, you test for the existence of an reactive/function called pf_name when the relevant input object appears to be input$pfID. That's another reason why the reactive is never updated.
Note the change to the definition of input$pfID that I've made to improve the readability of the pfDataReactive object. (This change also probably means that you can do away with input$go entirely.)
As you say, I don't have access to your csv file, so I can't test your code completely. I've modified the body of the pfDataReactive to simply return the mtcars dataset as a string. I've also edited the code I've commented out to hopefully run correctly when you use it with the real csv file.
This code appears to give the behaviour you want,. Though, if I may make a subjective comment, I think the layout of your GUI is appaling. ;=)
library(shiny)
ui <- fluidPage(
fluidRow(
column(6, offset =3,
wellPanel(
"Choose Mandate and Date",
fluidRow(
column(4,selectInput("pfID",label = "",
# Modified to that "Pleaseselect a PF" returns NULL
choices = list("please select a PF"="","GF25", "FPM"),
selected = "please select a PF") ),
column(4, dateInput("pfDate",label="",value = Sys.Date()) ),
column(2, actionButton("go","Submit")),column(2,textOutput("selected_var"))
)
)
)
)
)
# Define server logic ----
server <- function(input, output) {
pfDataReactive <- reactive({
# Don't do anything until we have a PF csv file
req(input$pfID)
input$go
# Note the change to the creation of the file name
# pfData <- read.csv(file =paste(input$pfID,".csv",sep=""),sep=";",dec=",")
# pfData <- pfData[3:nrow(pfData),]
# Total = sum(pfData$Eco.Exp...Value.long)
# Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
# pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
# MDur <- pfData[1,15]
# If you want to print MDur in the selected_var output, MDur should be the retrun value from this reactive
# MDur
mtcars
})
output$selected_var <- renderText({
print("Yep!")
as.character(pfDataReactive())
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Next time, please, please, make more effort to provide a MWE. This post may help.
This is a good introduction to Shiny.
I am trying to create a Shiny App which can be used in the R workspace to create a user friendly front end to some code- so that someone can just type in and click some boxes instead of creating lists and dataframes themselves- and then what they input will be stored in the workspace in R to do the code. I have basically adapted someone else's code but can't work out how I save the dynamically created UI called col - which makes text inputs so if people type something in this is saved.
When I try to add some way of saving it I get an error 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 code is below, is there a way I can save the information from the text input?
CrossBreakUI <- function(id, number) {
ns <- NS(id)
tagList(
fluidRow(
column(4, numericInput(ns("n"), "Number of Groups in Cross-Break", value=5, min=1), uiOutput(ns("col")))
)
)
}
variables <- function(input, output, session, variable.number){
output$textInput <- renderUI({
ns <- session$ns
textInput(ns("textInput"),
label = "")
})
col_names <- reactive(paste0("col", seq_len(input$n)))
output$col <- renderUI({
ns <- session$ns
map(col_names(), ~ textInput(ns(.x), NULL))
})
reactive({
# Create Pair: variable and its value
df <- data.frame(
"variable.number" = variable.number,
stringsAsFactors = FALSE
)
})
}
ui <- fixedPage(
div(
CrossBreakUI("var1", 1)
))
server <- function(input, output) {
add.variable <- reactiveValues()
add.variable$df <- data.frame(
"n" = numeric(0),
"col" = character(0),
stringsAsFactors = FALSE
)
var1 <- callModule(variables, paste0("var", 1), 1)
observeEvent(input[[NS(paste0("var", 1), "n")]], {
add.variable$df[1,1] <- input[[NS(paste0("var", 1), "n")]]
})
**#THIS IS THE ERROR- IT DOES NOT SAVE THE TEXT INPUT FROM THIS VARIABLE**
observeEvent(input[[NS(paste0("var", 1), "col")]], {
add.variable$df[1,2] <- input[[NS(paste0("var", 1), "col")]]
})
observe({
assign(x ="CrossBreak", value=add.variable$df, envir= .GlobalEnv) })
}
Second revision
If my understanding is correct, I think this gets close to what you want. You have a numericInput. The UI presents a series of textInputs. The number of textInputs changes in response to changes in the numericInput's value. The values of the textInputs are saved to a variable in the global environment (and the value of this global variable is printed to the console as the app terminates). Values already entered in the textInputs are preserved when the UI updates.
My solution differs from yours in that you have one module attempting to control every textInput and a main server that attempts to interrogate each textInput to obtain its value. I use multiple instances of a single module, one for each textInput. Each module instance manages the persistence of its textInput's value independently of all the other instances.
library(shiny)
groupList <- list()
# Module to define a self-contained "write-my-value" textInput
writeMyValueTextInputUI <- function(id, idx) {
ns <- NS(id)
textInput(ns("groupName"), paste0("Group ", idx))
}
writeMyValueTextInput <- function(input, output, session, id) {
ns <- session$ns
# Initialise
observe ({
id <- as.numeric(id)
if (id <= length(groupList)) updateTextInput(session, "groupName", value=groupList[[id]])
})
observeEvent(input$groupName, {
req(input$groupName)
# Note global assignment
groupList[[id]] <<- input$groupName
})
rv <- reactive ({
input$groupName
})
return(rv)
}
ui <- fluidPage(
titlePanel("Crossbreak demo"),
sidebarLayout(
sidebarPanel(
numericInput("groupCount", "Number of groups in cross-break:", min=1, value=5),
),
mainPanel(
textOutput("groupCount"),
uiOutput("groupList")
)
)
)
server <- function(input, output, session) {
onStop(function() cat(paste0(groupList, collapse=", ")))
ns <- session$ns
controllers <- list()
output$groupList <- renderUI({
req(input$groupCount)
textInputs <- lapply(
1:input$groupCount,
function(x) {
id <- ns(paste0("text", x))
controllers[[x]] <- callModule(writeMyValueTextInput, id, x)
return(writeMyValueTextInputUI(id, x))
}
)
do.call(tagList, textInputs)
})
}
shinyApp(ui = ui, server = server)
=========================
I haven't tried running your code (it's not really a simple self-contained example), but the following is just one way of running an app from the console. (is that what you mean when you say "from the global environment?)...
myList <- list(
ui = bootstrapPage(
numericInput('n', 'Number of obs', 100),
plotOutput('plot')
),
server = function(input, output) {
output$plot <- renderPlot({ hist(runif(input$n)) })
}
)
if (interactive()) runApp(myList)
I based my code on this page which also has other examples...
Note that you can't do this if you're running an R script in a batch job, as the batch job has no context in which to display the app. Hence if (interactive())...
OK. Responding to OP's clarification, here's a really crude demonstraion of one way of doing what she wants. Note the use of the global assignment operator (<<-) in the observeEvent.
x <- NA
print(paste0("globalValue is currently: ", x))
myList <- list(
ui = bootstrapPage(
numericInput('n', 'Please give me a number', 100)
),
server = function(input, output) {
observeEvent(input$n, {x <<- input$n})
}
)
if (interactive()) runApp(myList)
print(paste0("globalValue is now: ", x))
On my system, stepping through these statements in the console gives:
> x <- NA
> print(paste0("globalValue is currently: ", x))
[1] "globalValue is currently: NA"
> myList <- list(
+ ui = bootstrapPage(
+ numericInput('n', 'Please give me a number', 100)
+ ),
+ server = function(input, output) {
+ observeEvent(input$n, {x <<- input$n})
+ }
+ )
> if (interactive()) runApp(myList)
Listening on http://127.0.0.1:4429
> print(paste0("globalValue is now: ", x))
[1] "globalValue is now: 104"
>
Obviously, this isn't a realistic production solution. Possible solutions might include:
Writing to a temporary Rds file in the app and then reading it in once the app terminates.
Using session$userData to store the required information whilst the app is running and then using onStop to do custom processing as the app terminates.
I'm sure there will be others.
[OP: As an aside, look at the length of my code compared to yours. Put yourself in the shoes of someone who's willing to provide solutions. Whose question are they most likely to answer: yours or mine? Providing compact, relevant code makes it far more likely you'll get a useful reply.]
I'm trying to make a simple financial calculator that is capable of converting currencies as well. I couldn't go on without quantmod, to download new information. But when I try to apply its functions in shiny, there's some problem that I couldn't make out.
library(shiny)
library(quantmod)
ui <- fluidPage(
sidebarPanel(
textInput("curr", "Currency"),
actionButton("go", "1 dollar equals to:")
),
mainPanel(
verbatimTextOutput("res")
)
)
server <- function(input, output, session) {
result <- reactiveValues(data = NULL)
observeEvent(input$go, {
getSymbols(input$curr)
result$data <- data.frame(`input$curr`)
wanted <- result$data[nrow(result$data), ncol(result$data)]
})
output$res <- renderText({
paste(wanted)
})
}
shinyApp(ui, server)
When I tried to do the same in other script, without the inputs of shiny, it worked pretty well.
When I used BRL=X as the input$curr, it should work as in the script shown below.
getSymbols("BRL=X")
data <- data.frame(`BRL=X`)
data[nrow(data),ncol(data)]
But the error message that appear says that object "input$curr" was not found.
I'm using RStudio's Shiny to make a basic MBTI personality test. A user answers four questions, and gets his personality type (e.g. ENTJ) with a corresponding link to Wikipedia to read more on his type (e.g. https://en.wikipedia.org/wiki/ENTJ).
To do this, first, I'm using actionButton, as described here. Second, I'm using a bunch of functions in server.R to make a working weblink:
shinyServer(function(input, output) {
# After the Submit button is clicked
init <- reactiveValues()
observe({
if(input$submit > 0) {
init$pasted <- isolate(paste("Your personality type is ",
input$b1, input$b2, input$b3, input$b4, sep=""))
init$link <- paste("https://en.wikipedia.org/wiki/",
input$b1, input$b2, input$b3, input$b4, sep="")
init$linktext <- a("Find out more about it here", href=init$link, target="_blank")
}
})
# Output
output$text1 <- renderText({
init$pasted
})
output$text2 <- renderText({
init$linktext
})
})
The problem is that, when I run the app, init$pasted works just fine, while init$linktext doesn't - saying
Error in cat(list(...), file, sep, fill, labels, append) :
argument 1 (type 'list') cannot be handled by 'cat'
Any ideas how to fix that? Thanks!
The output of a(...) is a list and cannot be rendered using renderText. You can use htmlOutput in the ui.R and renderUI on the server side, here's an example:
server <- function(input, output) {
output$html_link <- renderUI({
a("Find out more about it here", href=paste("https://en.wikipedia.org/wiki/","a","b","c","d", sep=""), target="_blank")
})
}
ui <- shinyUI(fluidPage(
htmlOutput("html_link")
))
shinyApp(ui = ui, server = server)