wilcox.test does not work in shiny - r

I am trying to build a 'data explorer' shiny app which contains DataTables, ggplot2 graphs and wilcox.test results. I can't seem to make the wilcox.test to work though.
Outside the shiny app, things work as it should:
dat <- data.frame(outcome=sample(c("died","survived",NA), 20, TRUE),
cntr=sample(c("hospa","hospb"), 20, TRUE),
s=rnorm(20),
t=rnorm(20), stringsAsFactors=FALSE)
wilcox.test(dat$s ~ dat$outcome)
Results:
Wilcoxon rank sum test
data: dat$s by dat$outcome
W = 25, p-value = 0.3301
alternative hypothesis: true location shift is not equal to 0
Within the shiny app, the code below gives an 'Error: grouping factor > must have exactly 2 levels'. (graphs & tables work fine; I have omitted these for clarity).
library(shiny)
library(dplyr)
dat <- data.frame(outcome=sample(c("died","survived",NA), 20, TRUE),
cntr=sample(c("hospa","hospb"), 20, TRUE),
s=rnorm(20),
t=rnorm(20), stringsAsFactors=FALSE)
ui <- navbarPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("s"="s", "t"="t"),
selected = "s"),
selectInput(inputId = "z",
label = "Color by:",
choices = c("outcome", "cntr"),
selected = "outcome")
),
mainPanel(
tabsetPanel(id="tabspanel", type = "tabs",
tabPanel(title = "Wilcox"),
h4(textOutput(outputId = "p")))
)
)
)
server <- function(input, output, session) {
df <- reactive({
data.frame(input$y, input$z)
})
output$p <- renderText({
wilcox.test(df()[,1] ~ df()[,2])
})
}
shinyApp(ui=ui, server=server)
If the code is rewritten:
wilcox.test(dat$s, dat$outcome)
then the error is 'Error: 'x' must be numeric'.
Can someone help?

The issue you are having is that the line
data.frame(input$y, input$z)
gets translated to something like
data.frame("s", "outcome")
which can't be reasonably handeled by wicox.text. You should use the following instead
data.frame(dat[[input$y]], dat[[input$z]])
There were also some other minor issues. See the code code below for a full fix.
library(shiny)
library(dplyr)
dat <- data.frame(outcome=sample(c("died","survived",NA), 20, TRUE),
cntr=sample(c("hospa","hospb"), 20, TRUE),
s=rnorm(20),
t=rnorm(20), stringsAsFactors=FALSE)
ui <- navbarPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("s"="s", "t"="t"),
selected = "s"),
selectInput(inputId = "z",
label = "Color by:",
choices = c("outcome", "cntr"),
selected = "outcome")
),
mainPanel(
tabsetPanel(id="tabspanel", type = "tabs",
tabPanel(title = "Wilcox",
verbatimTextOutput(outputId = "p")))
)
)
)
server <- function(input, output, session) {
df <- reactive({
data.frame(dat[[input$y]], dat[[input$z]])
})
output$p <- renderPrint({
wilcox.test(df()[,1] ~ df()[,2])
})
}
shinyApp(ui=ui, server=server)

Gregor's guess is quite spot on; below snippet from the server codes:
dat_subset <- reactive({
req(input$selected_type)
filter(dat, outcome %in% input$selected_type)
})
output$scatterplot <- renderPlot({
ggplot(data = dat_subset(), aes_string(x = input$x, y = input$y, color = input$z)) + geom_boxplot() + labs()
})
output$nsdtable <- DT::renderDataTable({
DT::datatable(data = dat_subset()[, 1:4],
options = list(pageLength = 10),
rownames = FALSE)
})

Related

Create graph based on selection of input and output

New to shiny. I am trying to create a plot based on chosen x and y values. Basically, whatever the user selects for the select1 and select2 selectInput function will graph it accordingly. My original data has many columns, not just two. When I try to graph very specific things, my code works great, but when I try to graph what the user "selects" it does not work.
library(shiny)
library(readr)
library(ggplot2)
library(dplyr)
data0 <- rnorm(n = 10, mean = 100, sd = 5)
data1 <- rnorm(n = 10, mean = 50, sd = 10)
data2 <- data.frame(data0, data1)
attach(data2)
ui <- fluidPage(
selectInput(inputId = "select1",
label = "select the x-axis",
choices = c(" ", "data0", "data1")
),
selectInput(inputId = "select2",
label = "select the y-axis",
choices = c(" ", "data0", "data1")
),
submitButton(text = "Apply Changes", icon = NULL, width = NULL),
plotOutput(outputId = "myplot")
)
server <- function(input, output) {
output$myplot <- renderPlot({
data2 %>%
ggplot(aes(input$select1 ~ input$select2))+
geom_point(alpha = 0.8)
})
}
shinyApp(ui = ui, server = server)
I had to add ggplot(aes(x = get(paste(input$select1)), y = get(paste(input$select2)) to make the input selects work.
library(shiny)
library(readr)
library(ggplot2)
library(dplyr)
data0 <- read_csv("DeltaX_Soil_Properties_Fall2020_Spring2021_Fall2021.csv")
data1 <- data0[!(data0$time_marker_sampled == "-9999"),]
attach(data1)
ui <- fluidPage(
selectInput(inputId = "select1",
label = "select the x-axis",
choices = c(" ", "elevation_navd88", "sediment_accretion", "days_between_sampling_and_deployment", "normalized_accretion", "soil_bulk_density", "soil_organic_matter_content", "soil_organic_carbon", "soil_organic_carbon_density")
),
selectInput(inputId = "select2",
label = "select the y-axis",
choices = c(" ", "elevation_navd88", "sediment_accretion", "days_between_sampling_and_deployment", "normalized_accretion", "soil_bulk_density", "soil_organic_matter_content", "soil_organic_carbon", "soil_organic_carbon_density")
),
submitButton(text = "Apply Changes", icon = NULL, width = NULL),
plotOutput(outputId = "myplot")
)
server <- function(input, output) {
output$myplot <- renderPlot({
data1 %>%
ggplot(aes(x = get(paste(input$select1)), y = get(paste(input$select2)), col = hydrogeomorphic_zone))+
geom_point(alpha = 0.8)
})
}
shinyApp(ui = ui, server = server)
If you want to use a variable as x or y, you can alternatively use aes_() instead of aes().
This would then result in:
ggplot(aes_(x = input$select1, y = input$select2))
Beware, that you need to add a tilde if you want to use a normal column name with aes_(), e.g.:
ggplot(aes_(x = ~elevation_navd88, y = input$select2))

Extract a value from reactive data frame in shiny

I am not sure how I extract a value from a reactive data frame and use it for calculation. The reactive output did not show up so I could not calculate what I want it the end. When I run the script below, I got an error as "$ operator is invalid for atomic vector"
Exercise<-c(A,B,C)
Var1<-c(60,90,50)
Var2<-c(0.5,0.7,0.3)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(numericInput(inputId = "Time1",
label = "Duration:",
min = 0,
max = 120,
value = 1),
selectInput(
inputId = "Drill1",
label = "Drill1",
choices = Exercise,
selected = "1")
),
mainPanel(h3(textOutput("Power"))
)
)
)
server <- function(input, output) {
d<- reactive({
res<-T1 %>%
filter(Exercise == input$Drill1)
res
})
output$Power <- renderPrint({
dataset <-d()
Int<-dataset$Var1[dataset$Exercise == input$Drill1]
results<-Time1*Int
results
})
}
I really appreciate your help in advance.
I tidied up your code a little bit and ran it in a new R session. Unfortunately, I couldn't reproduce this issue. The app below runs fine on my machine.
library(shiny)
library(dplyr)
T1 <- data.frame(
Exercise = c("A", "B", "C"),
Var1 = c(60, 90, 50),
Var2 = c(0.5, 0.7, 0.3)
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(
inputId = "Time1",
label = "Duration:",
min = 0,
max = 120,
value = 1
),
selectInput(
inputId = "Drill1",
label = "Drill1",
choices = T1$Exercise
)
),
mainPanel(h3(textOutput("Power")))
)
)
server <- function(input, output) {
d <- reactive({
filter(T1, Exercise == input$Drill1)
})
output$Power <- renderPrint({
dataset <- d()
Int <- dataset$Var1[dataset$Exercise == input$Drill1]
input$Time1*Int
})
}
shinyApp(ui, server)

how can I get more than one plot from several selected items in a checkbox?

Good morning,
in my dashboard I inserted a checkbox to select one or more output to display. In the ui I entered the checkbox and in the server all the conditions (if ... else if ...). When I launch the app it only shows me a plot, even when I select more than one choice in the checkbox. In addition it gives me this error in console:
"Warning in if (input$checkGroup == 1) { :the condition has length > 1 and only the first element will be used"
I suppose it's telling me that I can't handle more than one choice, how do I view all the plots I choose?
ui <- fluidPage(titlePanel("IULM Dashboard"), sidebarLayout(sidebarPanel(
selectInput("selection", "Choose a Dataset:",
choices = datasets),
("Barplot","Network",'Wordcloud', "LDA-Latent topic"),
#selected = "Barplot", inline = TRUE),
checkboxGroupInput("checkGroup", label = ("Checkbox group"),
choices = list("Barplot" = 1, "Network" = 2), selected = 1, inline = TRUE),
actionButton("update", "Change"))
, mainPanel(
uiOutput("plot")))
server <- function(input, output){
datasetInput <- reactive({
input$update
isolate({
withProgress({
setProgress(message = "Processing corpus...")
getTermMatrix(input$selection)
})
})
})
output$plot <- renderUI({
if(input$checkGroup== 1 ){
output$barplot <- renderPlot({
v=datasetInput()
dtm1 = removeSparseTerms(v, 0.992)
freq <- colSums(as.matrix(dtm1))
wf = data.frame(term = names(freq), occurrences = freq)
wf <- wf[order(wf$occurrences, decreasing = TRUE),]
wf2 = subset(wf[1:input$maxB,])
ggplot(wf2, aes(term, occurrences)) +
geom_bar(stat="identity", fill="darkred", colour="black", width=0.5)+
theme(axis.text.x=element_text(angle=45, hjust=1))+
ggtitle("Word barplot")})
plotOutput(outputId = "barplot", width = 600, height = 400)
}
else if(input$checkGroup== 2 ){
output$network <- renderPlot({
v=datasetInput()
dtm1 = removeSparseTerms(v, 0.992)
rowTotals <- apply(dtm1 , 1, sum)
dtm2 <- dtm1[rowTotals> 0, ]
wdtm <- weightTf(dtm2)
dtm1 <- removeSparseTerms(wdtm, 0.96)
dfm <- as.dfm(dtm1)
textplot_network(dfm, min_freq = 0.5, omit_isolated = TRUE,
edge_color = "#1F78B4", edge_alpha = 0.5, edge_size = 2,
vertex_color = "#4D4D4D", vertex_size = 2,
vertex_labelsize = 5, offset = NULL)})
plotOutput(outputId = "network", width = 600, height = 600)}
})
}
shinyApp(ui = ui, server = server)
You can try
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput("variable", "Variables to show:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear"))
),
mainPanel(
uiOutput("plots")
)))
server <- function(input, output) {
output$plots <- renderUI({
req(input$variable)
output = tagList()
if(any(input$variable %in% "cyl")){
tmp <- mtcars$cyl
output[[1]] <- renderPlot({plot(mtcars$mpg, tmp)})
}
if(any(input$variable %in% "am")){
tmp <- mtcars$am
output[[2]] <- renderPlot({boxplot(mtcars$mpg, tmp)})
}
output
})
}
shinyApp(ui = ui, server = server)

How to add comment to a reactive data table in shiny

This question is an extension of the question I posted: this question
I created a dataframe with 3 columns: num, id and val. I want my shiny app to do the following:
a dataframe dat is filtered by num column
select an value from id column from dat (selectInput).
add text comment in a text box (textInput)
click on an action button
A new column called comment is created in the data table, text comments are added to the comment column in the row where id equals the value selected.
The code is below. I cannot figure out why it's not working.
Thank a lot in advance!
library(shiny)
library(DT)
dat = data.frame(num=rep(1:2, each=5), id=rep(LETTERS[1:5],2), val=rnorm(10))
ui = fluidPage(
fluidRow(
column(12, selectInput('selectNum', label='Select Num',
choices=1:10, selected='')),
column(2, selectInput(inputId = 'selectID',
label = 'Select ID2',
choices = LETTERS[1:10],
selected='',
multiple=TRUE)),
column(6, textInput(inputId = 'comment',
label ='Please add comment in the text box:',
value = "", width = NULL,
placeholder = NULL)),
column(2, actionButton(inputId = "button",
label = "Add Comment"))
),
fluidRow (
column(12, DT::dataTableOutput('data') )
)
)
server <- function(input, output, session) {
## make df reactive
df = reactive ({ dat %>% filter(num %in% input$selectNum) })
df_current <- reactiveVal(df())
observeEvent(input$button, {
req(df_current())
## update df by adding comments
df_new <- df_current()
df_new[df_current()$id %in% input$selectID, "Comment"] <- input$comment
df_current(df_new)
})
output$data <- DT::renderDataTable({
req(df_current())
DT::datatable(df_current(),
options = list(orderClasses = TRUE,
lengthMenu = c(5, 10, 20), pageLength = 5))
})
shinyApp(ui=ui, server=server)
Instead of using a reactive/eventReactive statement for df, it might be more natural to keep track of previously inputted comments in the Comment column using a reactiveVal object for df. See also the responses to this question: R Shiny: reactiveValues vs reactive. If you prefer to use a reactive/eventReactive statement for df it is probably better to work with a separate object to store previous input comments (instead of incorporating it into the reactive statement for df).
library(shiny)
library(DT)
dat = data.frame(num=1:10, id=LETTERS[1:10], val=rnorm(10))
ui = fluidPage(
fluidRow(
column(12, selectInput('selectNum', label='Select Num',
choices=1:10)),
column(2, selectInput(inputId = 'selectID',
label = 'Select ID2',
choices = LETTERS[1:10],
selected='',
multiple=TRUE)),
column(6, textInput(inputId = 'comment',
label ='Please add comment in the text box:',
value = "", width = NULL,
placeholder = NULL)),
column(2, actionButton(inputId = "button",
label = "Add Comment"))
),
fluidRow (
column(12, DT::dataTableOutput('data') )
)
)
server <- function(input, output, session) {
## make df reactive
df_current <- reactiveVal(dat)
observeEvent(input$button, {
req(df_current(), input$selectID %in% dat$id)
## update df by adding comments
df_new <- df_current()
df_new[df_current()$id %in% input$selectID, "Comment"] <- input$comment
df_current(df_new)
})
output$data <- DT::renderDataTable({
req(df_current())
## filter df_current by 'selectNum'
df_filtered <- df_current()[df_current()$num %in% input$selectNum, ]
## show comments if non-empty
showComments <- is.null(df_filtered$Comment) || !all(is.na(df_filtered$Comment))
DT::datatable(df_filtered,
options = list(orderClasses = TRUE,
lengthMenu = c(5, 10, 20), pageLength = 5,
columnDefs = list(
list(targets = ncol(df_filtered), visible = showComments)
)
)
)
})
}
shinyApp(ui=ui, server=server)
Edit: below an edited server function that using df_current <- reactive({...}) instead of df_current <- reactiveVal({...}) and defining a separate reactiveVal object to keep track of the comments.
server <- function(input, output, session) {
## initialize separate reactive object for comments
df_comments <- reactiveVal({
data.frame(
id = character(0),
Comment = character(0),
stringsAsFactors = FALSE
)
})
## reactive object df
df_current <- reactive({
## reactivity that df depends on
## currently df = dat does not change
df <- dat
## merge with current comments
if(nrow(df_comments()) > 0)
df <- merge(df, df_comments(), by = "id", all.x = TRUE)
return(df)
})
observeEvent(input$button, {
req(input$selectID)
## update df_comments by adding comments
df_comments_new <- rbind(df_comments(),
data.frame(id = input$selectID, Comment = input$comment)
)
## if duplicated id's keep only most recent rows
df_comments_new <- df_comments_new[!duplicated(df_comments_new$id, fromLast = TRUE), , drop = FALSE]
df_comments(df_comments_new)
})
output$data <- DT::renderDataTable({
req(df_current())
## filter df_current by 'selectNum'
df_filtered <- df_current()[df_current()$num %in% input$selectNum, ]
## show comments if non-empty
showComments <- is.null(df_filtered$Comment) || !all(is.na(df_filtered$Comment))
DT::datatable(df_filtered,
options = list(orderClasses = TRUE,
lengthMenu = c(5, 10, 20), pageLength = 5,
columnDefs = list(
list(targets = ncol(df_filtered), visible = showComments)
)
)
)
})
}
There you have got a working example.
I think the thing is that you are trying to update a value through an observeEvent which is not good according to the documentation. ?observeEvent
Use observeEvent whenever you want to perform an action in response to an event. (Note that "recalculate a value" does not generally count as performing an action–see eventReactive for that.)
library(shiny)
library(DT)
dat = data.frame(num=1:10, id=LETTERS[1:10], val=rnorm(10))
ui = fluidPage(
fluidRow(
column(12, selectInput('selectNum', label='Select Num',
choices=1:10, selected='')),
column(2, selectInput(inputId = 'selectID',
label = 'Select ID2',
choices = LETTERS[1:10],
selected='',
multiple=TRUE)),
column(6, textInput(inputId = 'comment',
label ='Please add comment in the text box:',
value = "", width = NULL,
placeholder = NULL)),
column(2, actionButton(inputId = "button",
label = "Add Comment"))
),
fluidRow (
column(12, DT::dataTableOutput('data') )
)
)
server <- function(input, output, session) {
## make df reactive
df_current = reactive({
df = dat %>% filter(num %in% input$selectNum)
if(input$button != 0) {
input$button
df[df$id %in% input$selectID, "Comment"] <- isolate(input$comment)
}
return(df)
})
output$data <- DT::renderDataTable({
req(df_current())
DT::datatable(df_current(),
options = list(orderClasses = TRUE,
lengthMenu = c(5, 10, 20), pageLength = 5))
})
}
shinyApp(ui=ui, server=server)
So you can either go with your reactive value or using eventReactive as stated in the doc.

R Shiny: Computing new Variables selected by "selectInput"

I'm working on a dashbord with Shiny and want to compute new variables based on the selected Variabels by selectInput.
Comparable to this in normal R-Code:
library(dplyr)
new_df <- old_df %>% mutate(new_1 = old_var1 + old_var2)
I'm able to compute new values with the sliderInput, but this are only single values. I want to compute a hole new variable with all the oppertunities of displaying the new variable in Tables and graphics.
Please try the followring syntax (the data is online avalible).
As you mentioned, all Inputs are working as they should.
library(shiny)
library(readr)
library(ggplot2)
library(stringr)
library(dplyr)
library(DT)
library(tools)
load(url("http://s3.amazonaws.com/assets.datacamp.com/production/course_4850/datasets/movies.Rdata"))
ui <- fluidPage(
sidebarLayout(
# Inputs
sidebarPanel(
h3("Plotting"), # Third level header: Plotting
# Select variable for y-axis
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("IMDB rating" = "imdb_rating",
"IMDB number of votes" = "imdb_num_votes",
"Critics Score" = "critics_score",
"Audience Score" = "audience_score",
"Runtime" = "runtime"),
selected = "audience_score"),
# Select variable for x-axis
selectInput(inputId = "x",
label = "X-axis:",
choices = c("IMDB rating" = "imdb_rating",
"IMDB number of votes" = "imdb_num_votes",
"Critics Score" = "critics_score",
"Audience Score" = "audience_score",
"Runtime" = "runtime"),
selected = "critics_score"),
# Select variable for color
selectInput(inputId = "z",
label = "Color by:",
choices = c("Title Type" = "title_type",
"Genre" = "genre",
"MPAA Rating" = "mpaa_rating",
"Critics Rating" = "critics_rating",
"Audience Rating" = "audience_rating"),
selected = "mpaa_rating"),
hr(),
# Set alpha level
sliderInput(inputId = "alpha",
label = "Alpha:",
min = 0, max = 1,
value = 0.5),
# Set point size
sliderInput(inputId = "beta",
label = "Beta:",
min = 0, max = 5,
value = 2)
),
# Output:
mainPanel(plotOutput(outputId = "scatterplot"),
textOutput(outputId = "description"),
DT::dataTableOutput("moviestable"))
)
)
server <- function(input, output, session) {
output$scatterplot <- renderPlot({
ggplot(data = movies, aes_string(x = input$x, y = input$y,
color = input$z)) +
geom_point(alpha = input$alpha, size = input$beta) +
labs(x = toTitleCase(str_replace_all(input$x, "_", " ")),
y = toTitleCase(str_replace_all(input$y, "_", " ")),
color = toTitleCase(str_replace_all(input$z, "_", " ")))
})
vals <- reactiveValues()
observe({
vals$x <- input$alpha
vals$y <- input$beta
vals$sum <- vals$x + vals$y
})
output$description <- renderText({
paste0("Alpha: ",input$alpha, " Beta:", input$beta," and the sum of alpha and beta:",vals$sum, ".")
})
output$moviestable <- DT::renderDataTable({
DT::datatable(data = movies,
options = list(pageLength = 10),
rownames = FALSE)
})
}
shinyApp(ui = ui, server = server)
I tried different ways to solve this problem:
1st try:
vals2 <- reactiveValues()
observe({
vals2$x <- input$y
vals2$y <- input$x
vals2$sum <- vals2$x + vals2$y
})
output$description2 <- renderText({
paste0("Input y: ",input$y, " Input x:", input$x," and the sum of both variables is:",vals2$sum, ".")
})
Warning: Error in +: non-numeric argument to binary operator
Stack trace (innermost first):
56: observerFunc [C:/Users/XXXXXX/Desktop/app.R#110]
1: runApp
ERROR: [on_request_read] connection reset by peer
2nd try:
output$try2 <- renderUI({
movies_2 <- movies %>% mutate(new_1 = input$y + input$x)
})
output$moviestable2 <- DT::renderDataTable({
DT::datatable(data = movies_2,
options = list(pageLength = 10),
rownames = FALSE)
})
Warning: Error in inherits: object 'movies_2' not found
I've no idea where I what I can try next...
I'm very happy for every kind of help!
You should make movies_2 in a reactive. Your output$try2 won't work because its expecting UI objects.
To match the call you make on the UI side I've renamed back to moviestable and have changed input$x + input$y to paste0(input$y, input$x) since they are both character.
movies_2 <- reactive({
movies %>% mutate(new_1 := movies[[input$x]] + movies[[input$y]])
})
output$moviestable <- DT::renderDataTable({
DT::datatable(data = movies_2(),
options = list(pageLength = 10),
rownames = FALSE)
})

Resources