Indexing a variable twice in R shiny - r

I'm trying to do some integration testing on my Shiny app, but I don't know what I'm doing wrong. I suspect it has to do with the fact I used the "$" twice when trying to access the likelihood, color, and riskMessage variables.
I keep running into this error:
Error in checkEqualsNumeric(output$coloredBox$likelihoodOfHarm, 0.75) :
Modes: NULL, numeric
Lengths: 0, 1
target is NULL, current is numeric
Here is my Shiny app code, with my attempt to test the Shiny app at the bottom. Any help is greatly appreciated!
displayColoredBox<- function(color, riskMessage){
sidebarPanel(style=sprintf("background-color: %s; width: 300px; height: 300px;", color),
h3(sprintf("%s", riskMessage)) ) }
app <- shinyApp(
ui = fluidPage(
div(
id = "form",
sliderInput("count1", "First Slider Input", value=0, min=0, max=5000),
sliderInput("count2", "Second Slider Input", value=0, min=0, max=5000),
uiOutput("coloredBox")
)),
server <- function(input, output, session) {
output$coloredBox<-renderUI({
req(input$count1)
req(input$count2)
count1 <- input$count1;
count2 <- input$count2;
likelihood <- (count1*count2)/5000000
if (likelihood>1) {
color="red"
riskMessage="Extreme risk!"
} else if (likelihood>.65){
color="orange"
riskMessage="Very high risk!"
}
else if (likelihood>.35){
color="yellow"
riskMessage="High risk!"
}
else if (likelihood>.10){
color="blue"
riskMessage="Moderate risk!"
} else {
color="green"
riskMessage="Low risk!"
}
coloredBox=displayColoredBox(color, riskMessage)
})
}
)
testServer(app, {
session$setInputs(count1 = 1500)
session$setInputs(count2 = 2500)
checkEqualsNumeric(output$coloredBox$likelihood, 0.75)
checkEquals(output$coloredBox$riskMessage, "Very high risk!")
checkEquals(output$coloredBox$color, "orange")
})

output objects in Shiny Apps are not lists that you can access in the way you are trying to. In contrast, they are HTML objects. The shiny-way would be the following: Store your values as reactives that change according to the inputs. Check if the reactives have the desired values.
displayColoredBox<- function(color, riskMessage){
sidebarPanel(style=sprintf("background-color: %s; width: 300px; height: 300px;", color),
h3(sprintf("%s", riskMessage)) ) }
library(RUnit)
app <- shinyApp(
ui = fluidPage(
div(
id = "form",
sliderInput("count1", "First Slider Input", value=0, min=0, max=5000),
sliderInput("count2", "Second Slider Input", value=0, min=0, max=5000),
uiOutput("coloredBox")
)),
server <- function(input, output, session) {
likelihood <- reactive((input$count1*input$count2)/5000000)
boxValues <- reactiveValues(color="", riskMessage="")
observe({
req(input$count1)
req(input$count2)
if (likelihood()>1) {
boxValues$color="red"
boxValues$riskMessage="Extreme risk!"
} else if (likelihood()>.65){
boxValues$color="orange"
boxValues$riskMessage="Very high risk!"
}
else if (likelihood()>.35){
boxValues$color="yellow"
boxValues$riskMessage="High risk!"
}
else if (likelihood()>.10){
boxValues$color="blue"
boxValues$riskMessage="Moderate risk!"
} else {
boxValues$color="green"
boxValues$riskMessage="Low risk!"
}
})
output$coloredBox<-renderUI({
displayColoredBox(boxValues$color, boxValues$riskMessage)
})
}
)
testServer(app, {
session$setInputs(count1 = 1500)
session$setInputs(count2 = 2500)
checkEquals(likelihood(), 0.75)
checkEquals(boxValues$riskMessage, "Very high risk!")
checkEquals(boxValues$color, "orange")
})

Related

R shiny - checkboxes and action button combination issue

I have 2 checkboxes and 1 action button. When clicking on either of the checkboxes, a graph should output BUT only after clicking on the action button. The code I have bellow does this well already. My issue here is that once the action button has been clicked and the graph generated, unclicking the checkbox removes the graph. Similarly, clicking again generates a new graph without clicking on the action button. I would like for the graph to stay on the screen for as long as I dont click on the action button again. I imagine this has to do with "isolating" the checkboxes but Im not too sure how to do so.
As a side note, imagine there was a third function generating a plot in my server when clicking on the action button (regardless of the checkboxes). Is there a way to code my "showmodal, removemodal" such that the pop up stays while all functions are running (instead of only during the first function)?
Here is my code
library(shiny)
#Function 1
X <- function(a,b,c){
plot(c(a,b),c(b,c))
}
#Function 2
Y <- function(d,e,f){
plot(c(d,e),c(e,f))
}
ui <- fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(
checkboxInput("EF", "Efficient Frontier"),
checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
actionButton("Go", "Go", style="color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
),
mainPanel(
fluidRow(
align = "center",
conditionalPanel(condition = "input.EF == true", plotOutput("GraphEF")),
conditionalPanel(condition = "input.MonteCarlo == true", plotOutput("GraphMC"))
)
)
)
)
server <- function(input, output) {
OPw <- reactiveValues()
output$Graphw <- renderPlot({
OPw$PC}, height = 400, width = 400)
observeEvent(input$Go, {
showModal(modalDialog("Loading... Please Wait", footer=NULL))
output$GraphEF <- renderPlot({ #Efficient Frontier
if(input$EF){
X(5,10,15)
}
}, height = 550, width = 700)
output$GraphMC <- renderPlot({ #Monte Carlo Simulation
if(input$MonteCarlo){
Y(5,10,15)
}
},height = 550, width = 700)
removeModal() #Removes Loading Pop-up Message
})
}
shinyApp(ui = ui, server = server)
Thanks a lot for your help!
Perhaps you should use eventReactive(). Try this
library(shiny)
# Function 1
X <- function(a, b, c) {
plot(c(a, b), c(b, c))
}
# Function 2
Y <- function(d, e, f) {
plot(c(d, e), c(e, f))
}
ui <- fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(
checkboxInput("EF", "Efficient Frontier"),
checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
actionButton("Go", "Go", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
),
mainPanel(
fluidRow(
align = "center",
uiOutput("plot1"),
plotOutput("GraphMC")
)
)
)
)
server <- function(input, output) {
GEF <- eventReactive(input$Go, {
if (input$EF) {
X(5, 10, 15)
} else {
NULL
}
})
showme <- eventReactive(input$Go, {
if (input$EF) TRUE else FALSE
})
GMC <- eventReactive(input$Go, {
if (isolate(input$MonteCarlo)) {
Y(5, 10, 15)
} else {
NULL
}
})
output$GraphMC <- renderPlot({
GMC()
})
output$GraphEF <- renderPlot({ # Efficient Frontier
GEF()
})
output$plot1 <- renderUI({
if (showme()) {plotOutput("GraphEF")} else NULL
})
observeEvent(input$Go, {
showModal(modalDialog("Loading... Please Wait", footer = NULL))
Sys.sleep(2)
removeModal() # Removes Loading Pop-up Message
})
}
shinyApp(ui = ui, server = server)
Leaving a conditionalPanel-approach, which is referring to a discussion over here:
library(shiny)
# Function 1
X <- function(a, b, c) {
plot(c(a, b), c(b, c))
}
# Function 2
Y <- function(d, e, f) {
plot(c(d, e), c(e, f))
}
ui <- fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(
checkboxInput("EF", "Efficient Frontier"),
checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
actionButton("Go", "Go", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
),
mainPanel(
fluidRow(
align = "center",
conditionalPanel("output.showme == true", plotOutput("GraphEF")),
plotOutput("GraphMC")
)
)
)
)
server <- function(input, output) {
GEF <- eventReactive(input$Go, {
if (input$EF) {
X(5, 10, 15)
} else {
NULL
}
})
output$showme <- eventReactive(input$Go, {
if (input$EF) TRUE else FALSE
})
outputOptions(output, "showme", suspendWhenHidden = FALSE)
GMC <- eventReactive(input$Go, {
if (isolate(input$MonteCarlo)) {
Y(5, 10, 15)
} else {
NULL
}
})
output$GraphMC <- renderPlot({
GMC()
})
output$GraphEF <- renderPlot({ # Efficient Frontier
GEF()
})
observeEvent(input$Go, {
showModal(modalDialog("Loading... Please Wait", footer = NULL))
Sys.sleep(2)
removeModal() # Removes Loading Pop-up Message
})
}
shinyApp(ui = ui, server = server)
Furthermore, please see this related answer.
The modal is working well, because both functions take so little time to run it creates de sensation than is there less than it should be. We can show this by adding a sys.sleep to simulate a long calculation.
Regarding the checkboxes, using conditionalPanel will hide or show the plots independently of the presence of isolate inside the server. A workaround is just to return NULL when the checkbox is not clicked.
library(shiny)
# Function 1
X <- function(a, b, c) {
plot(c(a, b), c(b, c))
}
# Function 2
Y <- function(d, e, f) {
plot(c(d, e), c(e, f))
}
ui <- fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(
checkboxInput("EF", "Efficient Frontier"),
checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
actionButton("Go", "Go", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
),
mainPanel(
fluidRow(
align = "center",
plotOutput("GraphEF"),
plotOutput("GraphMC")
)
)
)
)
server <- function(input, output) {
OPw <- reactiveValues()
output$Graphw <- renderPlot(
{
OPw$PC
},
height = 400,
width = 400
)
observeEvent(input$Go, {
showModal(modalDialog("Loading... Please Wait", footer = NULL))
output$GraphEF <- renderPlot(
{ # Efficient Frontier
if (isolate(input$EF)) {
X(5, 10, 15)
} else {
NULL
}
},
height = 550,
width = 700
)
Sys.sleep(2)
output$GraphMC <- renderPlot(
{ # Monte Carlo Simulation
if (isolate(input$MonteCarlo)) {
Y(5, 10, 15)
} else {
NULL
}
},
height = 550,
width = 700
)
removeModal() # Removes Loading Pop-up Message
})
}
shinyApp(ui = ui, server = server)

How to add a unit conversion button to numericInput in a shiny app?

I am trying to build a shiny app in which users can provide a (numeric) parameter in different units. For this, I would like to have an input field to fill in the numeric value (e.g. like the one that the numericInput function provides) and two buttons (e.g. the buttons that the radioButtons function provides) in the same line, in which the user can specify which unit is used. It would look something like this example:
Ideally, the values of the min and max arguments in the numericInput depend on which unit is specified by the user. For example, the parameter creatinine can be provided in mg/dL and in umol/L where the conversion factor is 1 mg/dL = 88.42 umol/L and the allowed range would be 0.1 to 15 in mg/dL and 8.842 to 1326.3 in umol/L.
In addition to the dependency of min and max on the unit specified by the user, I would like to be able to make calculations with the numeric value (creat in the example below) that - depending on the unit specified by the user - takes the conversion factor into account (e.g. with an if else construction in the server function).
Is this possible in shiny and if yes how would you do it in the below example?
library(shiny)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId="creat",label="Creatinine",value="",min=0,max=15,)),
mainPanel(p('Some calculation with creatinine'),
textOutput("creat"))
)
))
server <- function(input, output) {
output$creat <- renderText({input$creat*100})
}
shinyApp(ui = ui, server = server)
Many thanks in advance!
Perhaps this will meet your needs.
library(shiny)
ui <- shinyUI(fluidPage(
tags$head(
tags$style(HTML("
#creat {
width: 110px;
}
"))),
tags$head( tags$style(type="text/css","label{ display: table-cell; text-align: center;vertical-align: middle; } .form-group { display: table-row;}") ),
sidebarLayout(
sidebarPanel(
div(style= "display: inline;",
numericInput(inputId="creat",label="Creatinine ",value="",min=0.1,max=15,step=0.1, width = "80px")),
div(style= "display: inline;",
awesomeRadio(
inputId = "units",
label = "",
choices = list("mg/dl" = "mg", "umol/L" = "um"),
selected = "mg",
inline = TRUE,
status = "success",
width = "300px"
)
)
),
mainPanel(p('Some calculation with creatinine'), verbatimTextOutput("value"),
textOutput("creat"))
)
))
server <- function(input, output, session) {
output$creat <- renderText({input$creat})
numbers <- reactive({
if (input$units=="um"){
minval <- 8.842
maxval <- 1326.3
}else {
minval <- 0.1
maxval <- 15
}
validate(
need(is.numeric(input$creat) & input$creat >= minval & input$creat <= maxval , sprintf("Please input a number between %s to %s", minval,maxval))
)
})
output$value <- renderPrint({ numbers() })
observeEvent(input$units,{
print(input$units)
if (input$units=="um"){
if (is.null(input$creat)) value <- NULL
else value <- input$creat*88.42
updateNumericInput(
session = session, # getDefaultReactiveDomain(),
inputId = "creat",
value = value,
min = 8.842,
max = 1326.3,
step = 0.1
)
}else if (input$units=="mg") {
if (is.null(input$creat)) value <- NULL
else value <- input$creat/88.42
updateNumericInput(
session = session, # getDefaultReactiveDomain(),
inputId = "creat",
value = value,
min = 0.1,
max = 15,
step = 0.1
)
}
})
}
shinyApp(ui = ui, server = server)

ShinyApp Function not returning Result

I need help with the below shiny app server function. My problem is values$npv always comes out null, not even with a 0. and I think the fun function is not doing the right thing and i'm out of ideas.
If I hard-code the renderText with paste("Net Present Value:", isolate(input$val_inv)) i always have a result but not what i want and this makes me guess the fun function is not working as it should.
inline_numericInput=function(ni){
tags$div( class="form-inline",ni)
}
ui <- shinyUI(fluidPage(
tags$head(tags$style("#side_panel{
padding-left:10px;
}
.form-group {
margin-bottom: 15px !important;
}
.form-inline .form-control {
width:80%;
}
label{ width:30px;}
")),
titlePanel("Example"),
sidebarLayout(
sidebarPanel(width = 4,id="side_panel",
fluidRow(
column(6, inline_numericInput(numericInput("val_inv", label = "Inv:", value = 0))),
),
fluidRow(
column(6, inline_numericInput(numericInput("val_r", label = "R:", value = 0))),
),
fluidRow(
column(6, inline_numericInput(numericInput("val_n", label = "N:", min = 50,value = 50))),
column(6, inline_numericInput(actionButton("btn_calcnpv", label = "Compute NPV")))
)
),
mainPanel(
p('Results:'),
textOutput("val_npv")
)
)
))
server <- function(input, output) {
values <- reactiveValues()
values$npv <- 0
observe({
input$btn_calcnpv
fun <- function(n){
cf <- 0
for (i in 1:n){
cf <- cf + isolate(input$val_inv)/(1+input$var_r)**i
}
cf
}
values$npv <- fun(isolate(input$val_n))- isolate(input$val_inv)
#values$npv <- values$npv - isolate(input$val_inv)
})
output$val_npv <- renderText({
if(input$btn_calcnpv)
paste("Net Present Value:", values$npv)
else ""
})
}
shinyApp(ui, server)
Here is an answer using eventReactive and not so many isolations.
Furthermore, the inputs are coerced to numbers before the calculation takes place.
Using eventReactive, the calculation is started by pressing the compute-button.
server <- function(input, output) {
npv <- eventReactive(input$btn_calcnpv, {
val_inv <- as.numeric(input$val_inv)
val_r <- as.numeric(input$val_r)
val_n <- as.numeric(input$val_n)
fun <- function(n){
cf <- 0
for (i in 1:n){
cf <- cf + val_inv/(1+val_r)**i
}
cf
}
temp <- fun(val_n)- val_inv
temp
})
output$val_npv <- renderText({
req(npv())
paste("Net Present Value:", npv())
})
}

conditionally output different colored text in Shiny

I would like Shiny to print out some different color text depending on the size of a vector. I was thinking something like:
output$some_text <- renderText({
if(length(some_vec) < 20){
paste("This is red text")
<somehow make it red>
}else{
paste("This is blue text")
<somehow make it blue>
...but then I realized, I'm doing this in the server, not the UI.
And, as far as I know, I can't move this conditional logic into the UI.
For example, something like this won't work in the UI:
if(length(some_vec)< 20){
column(6, tags$div(
HTML(paste("This text is ", tags$span(style="color:red", "red"), sep = ""))
)}
else{
tags$div(HTML(paste("This text is ", tags$span(style="color:blue", "blue"), sep = ""))
)}
Does anyone have any creative ideas?
Inspired by jenesaisquoi's answer I tried the following and it worked for me. It is reactive and requires no additional packages. In particular look at output$text3
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Reactive"),
sidebarLayout(
sidebarPanel(
helpText("Variables!"),
selectInput("var",
label = "Choose Variable",
choices = c("red", "blue",
"green", "black"),
selected = "Rojo"),
sliderInput("range",
label = "Range:",
min = 0, max = 100, value = c(0, 100))
),
mainPanel(
textOutput("text1"),
textOutput("text2"),
htmlOutput("text3"),
textOutput("text4")
)
)
))
server <- function(input, output) {
output$text1 <- renderText({
paste("You have selected variable:", input$var)
})
output$text2 <- renderText({
paste("You have selected range:", paste(input$range, collapse = "-"))
})
output$text3 <- renderText({
paste('<span style=\"color:', input$var,
'\">This is "', input$var,
'" written ', input$range[2],
' - ', input$range[1],
' = ', input$range[2] - input$range[1],
' times</span>', sep = "")
})
output$text4 <- renderText({
rep(input$var, input$range[2] - input$range[1])
})
}
# Run the application
shinyApp(ui = ui, server = server)
Came hunting for an answer to a similar question. Tried a simple approach that worked for my need. It uses inline html style, and htmlOutput.
library(shiny)
ui <- fluidPage(
mainPanel(
htmlOutput("some_text")
)
)
and
server <- function(input, output) {
output$some_text <- renderText({
if(length(some_vec) < 20){
return(paste("<span style=\"color:red\">This is red text</span>"))
}else{
return(paste("<span style=\"color:blue\">This is blue text</span>"))
}
})
}
Conditionals run server side--it wasn't precisely clear to me from opening question that the author needed the conditional to run in UI. I didn't. Perhaps a simple way to address the issue in common situations.
Well, I have the kernel of an idea, but I'm fairly new to anything HTML/CSS/JavaScript-related, so I'm sure it could be improved quite a bit. That said, this seems to work fairly well, as far as it goes.
The key functions are removeClass() and addClass(), which are well documented in their respective help files in shinyjs:
library(shiny)
library(shinyjs)
shinyApp(
ui = fluidPage(
useShinyjs(), ## Set up shinyjs
## Add CSS instructions for three color classes
inlineCSS(list(.red = "color: red",
.green = "color: green",
.blue = "color: blue")),
numericInput("nn", "Enter a number",
value=1, min=1, max=10, step=1),
"The number is: ", span(id = "element", textOutput("nn", inline=TRUE))
),
server = function(input, output) {
output$nn <- renderText(input$nn)
observeEvent(input$nn, {
nn <- input$nn
if(is.numeric(as.numeric(nn)) & !is.na(as.numeric(nn))) {
## Clean up any previously added color classes
removeClass("element", "red")
removeClass("element", "green")
removeClass("element", "blue")
## Add the appropriate class
cols <- c("blue", "green", "red")
col <- cols[cut(nn, breaks=c(-Inf,3.5, 6.5, Inf))]
addClass("element", col)
} else {}
})
})
It sounds like you are trying to keep it all on the client side, so you could just use a couple of conditionalPanels, which accept javascript as conditional code. For example, coloring the text in response to the current value in a numericInput box with id "len",
library(shiny)
ui <- shinyUI(
fluidPage(
fluidRow(
numericInput('len', "Length", value=19),
conditionalPanel(
condition = "$('#len').val() > 20",
div(style="color:red", "This is red!")),
conditionalPanel(
condition = "$('#len').val() <= 20",
div(style="color:blue", "This is blue!"))
)
)
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server=server)
You could also add an event listener to update the text with javascript. It's kinda ugly inline (and I don't know much javascript), but you could just move the script to a file in wwww/ and use includeScript. As in the previous example, the server does nothing.
ui <- shinyUI(bootstrapPage(
numericInput('len', "Length", value=19),
div(id="divvy", style="color:blue", "This is blue!"),
tags$script(HTML("
var target = $('#len')[0];
target.addEventListener('change', function() {
var color = target.value > 20 ? 'red' : 'blue';
var divvy = document.getElementById('divvy');
divvy.style.color = color;
divvy.innerHTML = divvy.innerHTML.replace(/red|blue/g, color);
});
"))
))
Here's a more flexible answer that uses shinyjs::extendShinyjs() to give R a way to produce some parameterized JavaScript code. Compared to my other answer, the advantage of this one is that the same function can be used to reactively colorize multiple numeric outputs.
library(shiny)
library(shinyjs)
jsCode <-
"shinyjs.setCol = function(params){
var defaultParams = {
id: null,
color : 'red'
};
params = shinyjs.getParams(params, defaultParams);
$('.shiny-text-output#' + params.id).css('color', params.color);
}"
setColor <- function(id, val) {
if(is.numeric(as.numeric(val)) & !is.na(as.numeric(val))) {
cols <- c("green", "orange", "red")
col <- cols[cut(val, breaks=c(-Inf,3.5, 6.5, Inf))]
js$setCol(id, col)
}
}
shinyApp(
ui = fluidPage(
useShinyjs(), ## Set up shinyjs
extendShinyjs(text = jsCode),
numericInput("n", "Enter a number", 1, 1, 10, 1),
"The number is: ", textOutput("n", inline=TRUE),
br(),
"Twice the number is: ", textOutput("n2", inline=TRUE)
),
server = function(input, output) {
output$n <- renderText(input$n)
output$n2 <- renderText(2 * input$n)
observeEvent(input$n, setColor(id = "n", val = input$n))
observeEvent(input$n, setColor(id = "n2", val = 2 * input$n))
})

Shiny R renderPrint in loop usinf RenderUI only update the output

I am trying to dynamically render multiple text output from multiple text input. I tried to use this very helpfull example and this one too.
This conversation is also helpfull.
But when I try to adapt this examples on the following script, I have a problem of output update. Apparently, only the last element was read and updated. It's probably a reactivity problem but it seems to be difficult to associate reactive{()} and renderUI{()}functions.
rm(list = ls())
library(shiny)
creatDataElem <- function(ne, input) {
x1 <- lapply(1:ne, function(i) {
textInput(paste0("elemName", i),
label = h4(strong("Name of dataset element")),
value = "")
})
return(x1)
}
ui = (fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("elemNb",
"Number of elements", value = 1, min = 1,
max = 3)
,
conditionalPanel(
condition = "input.elemNb == 1",
creatDataElem(1)
),
conditionalPanel(
condition = "input.elemNb == 2",
creatDataElem(2)
),
conditionalPanel(
condition = "input.elemNb == 3",
creatDataElem(3)
)
),
mainPanel(
uiOutput("nameElem")
)
)
)
)
server = function(input, output, session) {
max_elem <- 3
# Name
output$nameElem <-renderUI({
nameElem_output_list <- lapply(1:input$elemNb, function(i) {
elemName <- paste0("elemName", i)
tags$div(class = "group-output",
verbatimTextOutput(elemName)
)
})
do.call(tagList, nameElem_output_list)
})
for (i in 1:max_elem) {
local({
force(i)
my_i <- i
elemName <- paste0("elemName", my_i)
output[[elemName]] <- renderPrint(input[[elemName]])
})
}
}
runApp(list(ui = ui, server = server))
The idea with a reactive({}) function is to add an independant object (a function in this case) like:
nameElem <- reactive({
if (input$goElem == 0) {
return()
} else {
isolate({
if (is.null(input$elemName)) {
return()
} else if (test(input$elemName)) {
return("TEST RESULT")
} else {
return(input$elemName)
}
})
}
})
and to use renderUI on this object (with an ActionButton).
So, if someone knows why the output does not return the good object...
I think one of your problems is that your creatDataElem function is such that when it is called with argument ne=3, the first and second textInput elements are created again (and their value "lost").
Anyway, I think one solution would be to create those textInput elements as an "uiOutput".
You'll find a possible solution below which (I think) does what you want.
Lise
rm(list = ls())
library(shiny)
ui = (fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("elemNb",
"Number of elements", value = 1, min = 1,
max = 3),
uiOutput("myUI")
),
mainPanel(
uiOutput("nameElem")
)
)
)
)
server = function(input, output, session) {
output$myUI=renderUI({
w=""
for (i in 1:input$elemNb){
w=paste0(w,
textInput(paste0("elemName",i),label='Name of dataset element'))
}
HTML(w)
})
output$nameElem <-renderUI({
elems=c("<div>")
for(i in 1:input$elemNb){
elems=paste(elems,"</div><div>",input[[paste0("elemName",i)]])
}
elems=paste0(elems,"</div>")
HTML(elems)
})
}
runApp(list(ui = ui, server = server))
Found a solution:
library(readr)
library(dplyr)
library(shiny)
df <- data.frame(symbol = 1:10)
uiOutput("myUI")
createUI <- function(dfID, symbol) {
div(class="flex-box",paste0(symbol, " - 10"))
}
output$myUI <- renderUI({
w <- lapply(seq_len(nrow(df)), function(i) {
createUI(i, df[i,"symbol"])
})
do.call(fluidPage,w)
})

Resources