I'm working on a some text mining. Based on the user's input I'm generating a number of suggestions for the next word. This part works fine. However the number of suggestions can be very large, so I want to show at most 10 suggestions in Shiny and I don't want to show NA values.
I created a reproducable example to exhibits the same problem. The trick I'm trying to use is pasting "suggestions" with i. This works when my output does not depend on my input. I got this from http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html.
My ui.R file
library(shiny)
fluidPage(
titlePanel("Test"),
fluidRow(
textAreaInput("userText", label="Enter your text")
),
fluidRow(
lapply(1:5, function(i) {
textOutput(paste0("suggestions", i))})
)
)
My server.R
library(shiny)
mySuggestions <- c("this", "is", "a", "test", "of", "getting", "reactive", "list", "length")
function(input, output, session) {
getWords <- function(i, wrds) {
output[[paste0("suggestions", i)]] <- renderText({ wrds()[i] })
}
userText <- reactive({
# Leaves this function when input$userText is NULL or ""
req(input$userText)
input$userText })
words <- reactive({
mySuggestions[1:userText()]
})
# Problem
lapply(reactive({ 1:min(5, length(words())) }), getWords(), wrds=words())
}
When you enter a positive integer in the ui text field the app is supposed to show as many words, but 5 at most.
The above version of the server.R results in a warning "Warning: Error in paste0: argument "i" is missing, with no default"
I've tried several versions for this problematic line.
reactive({ lapply(1:min(5, length(words())), getWords(), wrds=words() ) })
Gives no errors, but it shows nothing in the output.
lapply(1:min(5, length(words())), getWords() , wrds=words())
Results in a warning "Warning: Error in paste0: argument "i" is missing, with no default"
lapply(reactive({1:min(5, length(words()))}), getWords(), wrds=words())
Results in a warning "Warning: Error in paste0: argument "i" is missing, with no default"
lapply(reactive({1:min(5, length(words))}), function(i) {
output[[paste0("suggestions", i)]] <- renderText({ words[i] }) } )
Results in Error in as.vector(x, "list") :
cannot coerce type 'closure' to vector of type 'list'
lapply(reactive({1:min(5, length(words()))}), function(i) {
output[[paste0("suggestions", i)]] <- renderText({ words()[i] }) } )
Results in Error in as.vector(x, "list") :
cannot coerce type 'closure' to vector of type 'list'
reactive({lapply(1:min(5, length(words)), function(i) {
output[[paste0("suggestions", i)]] <- renderText({ words[i] }) }) })
Gives no errors, but it shows nothing in the output.
reactive({lapply(1:min(5, length(words())), function(i) {
output[[paste0("suggestions", i)]] <- renderText({ words()[i] }) }) })
Gives no errors, but it shows nothing in the output.
lapply(1:min(5, reactive({ length(words )})), function(i) {
output[[paste0("suggestions", i)]] <- renderText({ words[i] }) })
Results in Error in min(5, reactive({ : invalid 'type' (closure) of argument
lapply(1:min(5, reactive({ length(words() )})), function(i) {
output[[paste0("suggestions", i)]] <- renderText({ words()[i] }) })
Results in Error in min(5, reactive({ : invalid 'type' (closure) of argument
Now the following line shows the entered number of words in a single text field. When I enter 2 it shows 2 words and when I enter 20 it shows 5 words. This is the behaviour I want, but I want each word in a separate text field.
output$suggestions1 <- renderText(words()[1:min(5, length(words()))])
I'm getting lost. I was getting so desperate that I tried a few things I did not expect to work.
Is it possible to do what I want? If so, how? If not, what is the problem? I haven't found anything yet that addresses this specific problem.
The combination of outputUI and renderUI works great and keeps the code relatively simple.
ui.R
...
fluidRow(
uiOutput("suggestions")
)
server.R
library(shiny)
mySuggestions <- c("this", "is", "a", "test", "of", "getting", "reactive", "list", "length")
function(input, output, session) {
...
output$suggestions <- renderUI({
lapply(1:min(5, length(words())), function(i) {
output[[paste0("suggestions", i)]] <- renderText({ words()[i] })
}) })
}
I didn't know what outputUI and renderUI did, but they seem perfect for situations like these.
Related
I am getting errors as "Warning: Error in grepl: invalid 'pattern' argument" and "Error in [: incorrect number of dimensions" (in UI) while executing shiny code. please help. below is the snippet of the code. I am getting error when I am un-commenting last line
library(MASS)
library(shinythemes)
library(shiny)
library(ggplot2)
mass.tmp <- data(package = "MASS")[3]
mass.datasets <- as.vector(mass.tmp$results[,3])
ui <- fluidPage(
theme = shinytheme("superhero"),
titlePanel("Linear Regression Modelling"),
sidebarLayout(
sidebarPanel(
selectInput("dsname", "Dataset:",choices = c(mass.datasets)),
uiOutput("y_axis"),
uiOutput("x_axis")
) ,
mainPanel(
tags$br(),
tags$br(),
"R-squared:",
tags$span(tags$b(textOutput("rsquared")),style="color:blue")
)
)
)
server <- function(input, output) {
output$x_axis <- renderUI({
col_opts <- get(input$dsname)
selectInput("x_axis2", "Independent Variable:", choices = c(names(col_opts)))
})
cols2 <- reactive({
col_opts2 <- get(input$dsname)
#names(col_opts2)[!grepl(input$x_axis2, names(col_opts2))]
})
output$y_axis <- renderUI({
selectInput("y_axis2", "Dependent Variable:", choices = c(names(cols2())))
})
model <- reactive({
#lm(input$dsname[,names(input$dsname) %in% input$y_axis2] ~ input$dsname[,names(input$dsname) %in% input$x_axis2])
#tmp <- paste(input$y_axis2,"~",input$x_axis2,sep = " ")
lm( input$y_axis2 ~ input$x_axis2 , data = input$dsname )
})
model_summary <- reactive({summary(model())})
output$rsquared <- renderText({ model_summary()$r.squared })
}
shinyApp(ui = ui, server = server)
Yes thats better.
There a multiple errors:
We shouldnt debug it all for you, but here are quite some pointers.
That should help you to find them all.
1)
You are using: input$x_axis and input$y_axis but defined it with a "2" at the end. So adapt that.
2)
You should define:
cols2 <- reactive({
col_opts2 <- get(input$dsname)
names(col_opts2)[!grepl(input$x_axis2, names(col_opts2))]
})
outside the renderUI function.
3) Moreover, there seems to be something wrong with this snippet:
names(col_opts2)[!grepl(input$x_axis2, names(col_opts2))]
Finally, I would check if you produce NULLS and prohibit that by !is.null().
Edit: Question update:
You tried to build the lm()formula by strings, which you can test outside of shiny: Will not work.
You should use the formula() function and come up with somethin like:
lm(formula(paste(input$y_axis2, input$x_axis2, sep =" ~ ")), data = get(input$dsname))
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)
I've a problem with my shiny code which is somewhat related with the two questions I linked below.
So i've made a dynamic UI :
output$hmgroupsmean <-renderUI({
numGroups <- as.integer(input$HMgroups)
lapply(1:numGroups, function(i) {
numericInput(paste0("group_", i),
label= paste("Mean", i),
min=0,
max=1000,
value= 10)
})
})
that display N numericInput depending on how many groups the user has chosen.
Then I just want to retrieve all the mean and there begin the problem :
I tried what is explained here but it doesnt work :
output$PowerAnalysisANOVA <- renderPlot({
allmean = c()
lapply(1:numGroups, function(i){
allmean[i] <- input[[paste0("group_", i)]]
})
qplot(allname)
})
it returns :
Error : argument "env" is missing, with no default
then i tried something a tad more exotic :
output$PowerAnalysisANOVA <- renderPlot({
allname = c()
allmean = c()
lapply(1:numGroups, function(i){
allname[i] <- paste0("input$group_" ,i)
allmean[i] <- get(allname[i])
})
qplot(allmean)
})
But it doesn't work : Error :object 'input$group_1' not found
Edit after AndriyTkach's comment :
output$PowerAnalysisANOVA <- renderPlot({
allname = c()
allmean = c()
lapply(1:numGroups, function(i){
allname[i] <- eval(parse (text = paste0("input$group_" ,i)))
allmean[i] <- get(allname[i])
})
qplot(allmean)
})
It returns a new Error : invalid first argument
AndriyTkach proposed that :
for (i in 1:numGroups)
eval (parse (text = paste0("allmean[", i, "] <- input$group_" ,i)))
Which work a lot better : no Error message but it only work for 2 and 3 groups , the fourth and up is not taken into account
Create dynamic number of input elements with R/Shiny
accessing inputs created in renderUI in Shiny
After some discussion with AndriyTkach : I have a working program :
output$PowerAnalysisANOVA <- renderPlot({
allmean = c()
for (i in 1:values$numGroups)
eval (parse (text = paste0("allmean[", i, "] <- input$group_" ,i)))
qplot(allmean)
})
And I had forgotten to make a reactive variable :
values <- reactiveValues()
output$hmgroupsmean <-renderUI({
values$numGroups <- as.integer(input$HMgroups)
apply(1:values$numGroups, function(i) {
numericInput(paste0("group_", i),
label= paste("Condition", i),
min=0,
max=1000,
value= 10)
})
})
I have a problem with renderUI and I couldn't find a solution anywhere. Probably I'm asking the wrong question to google and more than a shiny problem is a basic R problem.
I have a function in R which depending on the input will return a table or a text. So I created both the options in my server.R in this way:
output$table <- renderTable {(
x <- function (y)
print(x)
)}
output$text <- renderText {(
x <- function (y)
print(x)
)}
If I put both the outputs in renderUI one will always give me an error. In case of textOutput if the output is a table:
Error: argument 1 (type 'list') cannot be handled by 'cat'
and
Error:no applicable method for 'xtable' applied to an object of class "character"
if it is viceversa.
My question is there a way to catch this error and use an if statement within renderUI to display only one of the two?
I'm here to give you more details if you need.
[EDIT]
server.R
library(shiny)
library(drsmooth)
shinyServer(function(input, output,session) {
-- upload dataframe and input management goes here --
output$nlbcd <- renderTable({
nlbcd<-nlbcd(dosecolumn="Dose", targetcolumn=response(),cutoffdose=cutoff(),data=data1())
print(nlbcd)
})
output$nlbcdText <- renderText({
nlbcd<-nlbcd(dosecolumn="Dose", targetcolumn=response(),cutoffdose=cutoff(),data=data1())
print(nlbcd)
})
output$tb <- renderUI({
tableOutput("nlbcd"),
textOutput("nlbcdText")
})
})
You have some issues here, the function will return different classes, including errors and warnings with interpretations. Here is a standalone example of what can happen with this function, you are encouraged to include the TryCatch in your code:
ui.R
shinyUI(
pageWithSidebar(
headerPanel("drsmooth"), sidebarPanel(
numericInput("num", label = h3("Choose 'cutoffdose'"), value = 0)
),
mainPanel(
verbatimTextOutput('current')
)
)
)
server.R
library(drsmooth)
shinyServer(function(input, output, session) {
output$current <- renderPrint({
dose <- input$num
tryCatch(isolate(nlbcd("dose", "MF_Log", cutoffdose=dose, data=DRdata)),
error=function(e) {
cat(isolate(conditionMessage(e)))
}
)
})
})
Sample outputs:
I would try to use function class().
output$table <- renderTable {(
x <- function (y)
if(class(x) == "table")
print(x)
)}
output$text <- renderText {(
x <- function (y)
if(class(x) == "list")
print(x)
)}
I'm using Shiny's renerUI to create UI objects on the fly following instruction from this question.
i'm getting the following error
Error in if (!grepl(pattern, text)) return(text) :
argument is of length zero
after reading this i know the problem is this line
# Convert the list to a tagList
do.call(tagList, plot_output_list)
but i'm doing exactly what the solution suggested.
appreciate any help.
the code
Server.r
shinyServer(function(input, output) {
# Create an environment for storing data
symbol_env <- new.env()
output$plots <- renderUI({
if (input$goButton == 0)
return()
if (loaded_index != input$chosen_index) {
# ... alot of code to generate data.frames and plots
output[["summary"]] <- renderPlot(grid.arrange(g1,g2,g3,g4,g5,nrow=1))
for (i in 1:length(results)) {
# Need local so that each item gets its own number. Without it, the value
# of i in the renderPlot() will be the same across all instances, because
# of when the expression is evaluated.
local({
my_i <- i
plotname <- object_name("plot", names(results[my_i]))
output[[plotname]] <- renderPlot({
showme_plot(results[[names(results[my_i])]]$data , period = DEFAULT_TIME_PERIOD)})
tablename <- object_name("table", names(results[my_i]))
output[[tablename]] <- renderTable({
make_summary(names(results[my_i]))})
})
}
}
plot_output_list <- list()
# Graphical Summary
plot_output_list[["summary"]] <- tags$div(class="summary" , plotOutput("summary"))
# The List
for (symbol in names(results))
plot_output_list[[symbol]] <-
tags$div(class = "container" ,
tags$div(class = "name" , name(symbol)),
tags$div(class = "stats" , tableOutput(object_name("table", symbol))) ,
tags$div(class = "plot" , plotOutput(object_name("plot", symbol), height = 530)))
print("Plot structure defined")
# Convert the list to a tagList
do.call(tagList, plot_output_list)
})
})
ui.r
require(shinyIncubator)
shinyUI(
bootstrapPage(
tags$script(src = "keyboard_scroller.js") ,
tags$link(rel="stylesheet" , type="text/css" , href="custom.css") ,
actionButton("goButton", "Go!") ,
selectInput("chosen_index" , "INDEX: " , list("A" = '1' , "B" = '2')) ,
# This is the dynamic UI for the plots
uiOutput("plots")
))
I would guess one problem is that the plot_output_list should not be indexed by strings, but instead by number, i.e. plot_output_list[[symbol]] <- ... should be plot_output_list[[i]] <- ...; i <- i + 1
If that doesn't work, try running traceback() right after you hit the error so we can see where the error comes from.