Related
I have my data frame named df...
pain_severity = c(1, 5, 10, 8, 6, 4)
urinary_severity = c(3, 8, 9, 7, 6, 10)
df = data.frame(pain_severity, urinary_severity)
I let the user choose whether they want pain or urinary severity in select input...
UI:
tabPanel("1-Variable Visualization",
sidebarLayout(
sidebarPanel(
h1("Menu Selection"),
selectInput(inputId = "variable_choice",
label = "Variable",
choices = df,
selected = "pain_severity")
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Boxplot", plotOutput("boxplot")),
)))))
SERVER:
server <- function(input, output, session) {
output$boxplot <- renderPlot({
boxplot(input$variable_choice,
data = df,
main = "", xlab="", ylab = "", horizontal = TRUE)
points(mean(input$variable_choice, na.rm = TRUE),
data = df,
1,
col = "red")
})
}
I keep getting an error that reads... ERROR: non-numeric argument to binary operator
Why does this happen? When I run the code in base R using just pain or urinary severity as my variable it works perfectly. When I ask it to adapt based on user input from variable_choice, it gives me that error message. Do I have to use ggplot when trying to run user inputs?
Your code has several issues:
the choices argument should only take a vector of column names, try choices = colnames(df)
the plot functions either need a formula (however I couldn't make it work without a grouping variable) or the data itself. Try:
output$boxplot <- renderPlot({
boxplot(df[input$variable_choice],
main = "", xlab=input$variable_choice, ylab = "", horizontal = TRUE)
points(mean(df[input$variable_choice], na.rm = TRUE),
1,
col = "red")
})
In this way, you use the character input$variable_choice to index your data.frame
Thank you. Starja is right. I have a more in depth code for choices based on user selections that I felt would bog down the original question so I simplified it by just writing df, but I should have said colnames(df), you're right. The boxplot works perfectly, but the point returns an NA value and the error says "argument is not numeric or logical: returning NA" and the point does not show up on the graph.
My solution to this was to use colMeans and define it in the server like so...
SERVER:
col_mean <- colMeans(filtered_data()[1:908], na.rm = TRUE)
points(col_mean[input$variable_choice], 1, col = "red")
I created col_mean to grab the first 908 numeric columns in my dataset and convert it to a one mean point in a new dataset. I then used that new dataset in points which gave me the correct mean display for each.
For this particular shiny example I am trying to apply a circular model and display and summarize it within the ggplot and a summary table. This is straightforward up until trying to add in reactive 'brushplot' capabilities. Each of the data points represent a date and the point of the selective graph is to be able to discard undesirable dates. As far as I've figured out, this requires the filtering and model fitting to be within a renderPlot which then leads to complications (unable to find the data/model) trying to call the filtered data and the circular model's statistical outputs outside the function and/or within another reactive function. This yields the Error: object 'k_circ.lm' not found So my questions are:
How can I read the filtered data from the renderPlot function
to the summarytable matrix?
How could I similarly add the fitted model values and residuals from k_circ.lm?
Is there a better or simpler way to arrange app to avoid this?
Alternatative code lines are commented out for a working (if poorly formatted) summary table.
library(dplyr) # For data manipulation
library(ggplot2) # For drawing plots
library(shiny) # For running the app
library(plotly) # For data manipulation
library(circular) # For Circular regressions
library(gridExtra)
# Define UI ----
ui <- fluidPage(
# App title ----
titlePanel("Circular Brushplot Demo"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
sidebarPanel(
actionButton("exclude_toggle", "Toggle points"),
actionButton("exclude_reset", "Reset")
),
# Main panel for displaying outputs ----
mainPanel(
#reactive plot output with point and 'brush' selection
fluidRow(plotOutput("k", height = 400,
click = "k_click",
brush = brushOpts(
id = "k_brush" ))),
plotOutput("s", height = 400)
)
)
)
# Define server logic
server <- function(input, output) {
psideg <- c(356,97,211,232,343,292,157,302,335,302,324,85,324,340,157,238,254,146,232,122,329)
thetadeg <- c(119,162,221,259,270,29,97,292,40,313,94,45,47,108,221,270,119,248,270,45,23)
## Data in radians then to "circular format"
psirad <- psideg*2*pi/360
thetarad <- thetadeg*2*pi/360
cpsirad <- circular(psirad)
cthetarad <- circular(thetarad)
cdat <- data.frame(cpsirad, cthetarad)
###### reactive brush plot ########
# For storing which rows have been excluded
vals <- reactiveValues(
keeprows = rep(TRUE, nrow(cdat)))
output$k <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep <- cdat[ vals$keeprows, , drop = FALSE]
exclude <- cdat[!vals$keeprows, , drop = FALSE]
## Fits circular model specifically for 'keeprows' of selected data
k_circlm <- lm.circular(type = "c-c", y = keep$cthetarad, x = keep$cpsirad, order = 1)
k_circlm
ggplot(keep, aes(cthetarad, cpsirad)) +
geom_point(aes(cthetarad, cpsirad, colour = keep$Vmag, size = 5))+
scale_colour_gradient(low ="blue", high = "red")+
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 13, size = 5, fill = NA, color = "black", alpha = 0.25) +
annotate("text", x = min(keep$cthetarad), y = Inf, hjust = .1, vjust = 1,
label = paste0("p value 1 = ", round(k_circlm$p.values[1], 2)), size = 7)+
annotate("text", x = min(keep$cthetarad), y = Inf, hjust = .1, vjust = 2.5,
label = paste0("p value 2 = ", round(k_circlm$p.values[2], 2)), size = 7)+
annotate("text", x = min(keep$cthetarad), y = Inf, hjust = .1, vjust = 4,
label = paste0("rho = ", round(k_circlm$rho, 2)), size = 7)+
xlab("Lighthouse Direction (radians)")+ ylab("ADCP site direction (radians)")+
theme(axis.title.x = element_text(size = 20), axis.title.y = element_text(size = 20))
})
# Toggle points that are clicked
observeEvent(input$k_click, {
res <- nearPoints(cdat, input$k_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)})
# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(cdat, input$k_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)})
# Reset all points
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE, nrow(cdat))})
output$s <- renderPlot({
# Create Summary table
summarytable <- data.frame(matrix(ncol = 4, nrow = nrow(keep)))
colnames(summarytable) <- c( "Psi_dir", "Theta_dir", "Fitted_values", "Residuals")
# Un-comment lines below to read from non-reactive data for working summary table
#summarytable$Psi_dir <- round(cdat$cpsirad, 2)
#summarytable$Theta_dir <- round(cdat$cthetarad, 2)
# attempting to pull from circlm within render plot
# comment out for summarytable to work
summarytable$Psi_dir <- round(keep$cpsirad, 2)
summarytable$Theta_dir <- round(keep$cthetarad, 2)
summarytable$Fitted_values <- round(k_circ.lm$fitted)
summarytable$Residuals <- round(k_circ.lm$residuals)
# outputing table with minimal formatting
summarytable <-na.omit(summarytable)
t <- tableGrob(summarytable)
Q <- grid.arrange(t, nrow = 1)
Q
}
)
}
shinyApp(ui = ui, server = server)
Here's a few ideas - but there are multiple approaches to handling this, and you probably want to restructure your server function a bit more after working with this further.
First, you probably want a reactive expression that will update your model based on vals$keeprows as this changes with your clicks. Then, you can access the model results from this expression from both your plot and data table.
Here is an example:
fit_model <- reactive({
## Keep and exclude based on reactive value keeprows
keep = cdat[ vals$keeprows, , drop = FALSE]
exclude = cdat[!vals$keeprows, , drop = FALSE]
## Fits circular model specifically for 'keeprows' of selected data
k_circlm <- lm.circular(type = "c-c", y = keep$cthetarad, x = keep$cpsirad, order = 1)
## Returns list of items including what to keep, exclude, and model
list(k_circlm = k_circlm, keep = keep, exclude = exclude)
})
It will return a list that you can access from the plot:
output$k <- renderPlot({
exclude <- fit_model()[["exclude"]]
keep <- fit_model()[["keep"]]
k_circlm <- fit_model()[["k_circlm"]]
ggplot(keep, aes(cthetarad, cpsirad)) +
...
And can access the same from your table (though you have as renderPlot?):
output$s <- renderPlot({
keep = fit_model()[["keep"]]
k_circ.lm <- fit_model()[["k_circlm"]]
# Create Summary table
summarytable <- data.frame(matrix(ncol = 4, nrow = nrow(keep)))
...
Note that because the table length changes with rows kept, you might want to use nrow(keep) as I have above, rather than nrow(cdat), unless I am mistaken.
I also loaded gridExtra library for testing this.
I suspect there are a number of other improvements you could consider, but thought this might help you get to a functional state first.
I am having some trouble with creating plots on eventReactive. I have a source code for inside event reactive, and I am trying to make multiple plots. I am a little unsure how to make multiple plots, so I tried to make one into a plot. However, I am still having trouble with this.
My ui and server are
library(shiny)
library(lpSolve)
ui <- fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Information required for the model",
sliderInput("Reservoirs", label = h3("Total Number of Reservoirs"),
min = 1, max = 25,
value = 10),
sliderInput("Municipalities", label = h3("Total Number of Municipalities Served by the Reservoirs"),
min = 1, max = 150,
value = 15),
sliderInput("Time", label = h3("Total Number of Months for Future Decision"),
min = 0, max = 60,
value = 0)
),
tabPanel("Summary of csv files",
actionButton("Run_Model", "Run Model")),
tabPanel("Results",
plotOutput("plot_ipsita"),
img(outfile)
)
)))
server <- function(input, output) {
running_code<-eventReactive(input$Run_Model, {
source("Source_code.R", local=TRUE)
outfile <- tempfile(fileext = '.png')
png(outfile,width=30,height=nR*3,units = "in",res=200)
par(mfrow=c(ceiling(nR)/2, 2))
for (i in 1:nR){
hist(abcd[i,1,1])
}
dev.off()
plot((colSums(abcd[1,,])),type="l",ylab="Withdrawal [mio m3]",xlab = "months",col=1,lwd=3,lty=1)
abline(h=130, col = 2,lwd=3,lty=3)
abline(h=205, col=3, lwd=3,lty=4)
legend("topleft", c("","All Reservoirs","Import","Failure"), col = c(0,1,2,3),pt.cex=0.5,lty=1:4,lwd=3, cex=0.75,bty="n")
title(paste0("Withdrawals from reservoirs and imports and failure for % initial storage" ), cex.main=1)
})
output$plot_ipsita <- renderPlot({
running_code()
})
}
shinyApp(ui = ui, server = server)
And my source code is
nR<-input$Reservoirs
nM<-input$Municipalities
nT<-input$Time
abcd<-array(data=0, c(nR,nM,nT))
for (i in 1:nR){
abcd[i,,]<-(1+i)*55
}
My actual code is a lot more complicated, so I tried to simplify it to test with this one, and it does not seem happy. Nothing is running. However, if I try to run it as a regular R code, I am able to get all the results.
Please help!!!
The mistake in your code is in your ui where your sliderInput Time has a default value 0. This causes the following loop to fail not assigning any value to array abcd:
for (i in 1:nR){
abcd[i,,]<-(1+i)*55
}
Hence, colSums(abcd[1,,]) dos not have the value due to which it fails.
If you change the sliderInput("Time", label = h3("Total Number of Months for Future Decision"), min = 0, max = 60, value = 0) to sliderInput("Time", label = h3("Total Number of Months for Future Decision"), min = 0, max = 60, value = 2) your code creates a graph as follows:
Hope it helps!
Goal: I am trying to create a shiny app that displays (1) the stressplot of a non-metric multidimensional scaling solution, (2) a ggplot of the point configuration, and (3) the results of clustering the point configuration by plotting the point configuration and superimposing chulls of the clustering.
Problem: The first two plots work without difficulty. Instead of a third plot, I get the error: 'data' must be of a vector type, was 'NULL'
I would appreciate any advice on how to resolve the specific problem, i.e. "error in array: 'data' must be of a vector type, was 'NULL'"
I would also appreciate any general advice on how to debug shiny. My only strategy is to treat the code like it isn't reactive code, and I suspect that this strategy isn't terribly effective.
My attempt to solve: I've searched the error on rseek and stack overflow and reviewed the posts. In some of the cases with similar errors the problem was that necessary data wasn't being calculated. I went through the code, treated it as normal (non-reactive) code, and used fake data. When I did this I didn't have any problem, so I assume it is something about the reactivity? Question 2 about how to debug is a reaction to the fact that trying to debug like the code wasn't dynamic didn't identify the problem.
Reproducible Example: I put together a shiny app that has randomly generated data. Before doing the testing I updated R and all the packages I use.
# Packages and options
library(shiny)
library(vegan)
library(cluster)
library(tidyverse)
options(digits = 3)
# Create dissimilarity matrix
d <- rnorm(1000)
mat <- matrix(d, ncol = 10)
diss_m <- daisy(mat) %>% as.matrix()
# Function
find_chulls <- function(df, x, y) {
ch <- chull(df[[x]], df[[y]])
df[ch,] %>% as.data.frame()
}
ui <- fluidPage(
titlePanel("Research"),
sidebarLayout(
sidebarPanel(
numericInput('dim', 'Dimensions', 2, min = 2, max = 15)
),
mainPanel(
h3('Stressplot'),
plotOutput('plot0'),
h3('Non-Metric Multidimensional Scaling'),
plotOutput('plot1'),
h3('2d Density Plot'),
plotOutput('plot2'),
h3('Cluster Analysis'),
plotOutput('plot3')
)
)
)
server <- function(input, output, session) {
nmds <- reactive({
metaMDS(diss_m,
distance = "euclidean",
k = input$dim,
trymax = 200,
autotransform = FALSE,
noshare = FALSE,
wascores = FALSE)
})
output$plot0 <- renderPlot({
stressplot(nmds())
})
pts <- reactive({
nmds()$points %>% as.data.frame()
})
output$plot1 <- renderPlot({
ggplot(pts(), aes(x = MDS1, y = MDS2)) +
geom_point()
})
output$plot2 <- renderPlot({
ggplot(pts(), aes(x = MDS1, y = MDS2)) +
geom_point() +
geom_density2d()
})
df_cl <- reactive({
km <- kmeans(x = pts(), centers = input$clust)
cl <- km$cluster
data.frame(pts(), clust = cl)
})
df_ch <- reactive({
df_ch_temp <- df_cl() %>% group_by(clust) %>% do(find_chulls(., 1, 2))
df_ch_temp %>% as.data.frame()
})
The plot below is the one that doesn't work
output$plot3 <- renderPlot({
ggplot(df_ch(), aes(x = MDS1, y = MDS2, fill = as.factor(clust))) + geom_polygon(alpha = 0.10)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Your input$clust is undefined in:
df_cl <- reactive({
km <- kmeans(x = pts(), centers = input$clust)
cl <- km$cluster
data.frame(pts(), clust = cl)
})
You need to add an input binding for clust, e.g.:
numericInput('clust', 'Clusters', 2, min = 2, max = 15)
As for debugging: I added browser() at the top in df_cl, then execution stops and you can inspect variables and run code in the terminal (e.g. in Rstudio). When I ran km <- kmeans(x = pts(), centers = input$clust) I got the error you described and could then see that input contains no clust element.
I created a shiny app, in which I want to display the residual of a log-linear model using a mosaic plot. I need to use the data from a reactive expression and pass it to loglm. It seem pretty strait forward, but when I do that I get the following error : "objet 'mod' introuvable".
I've already figured which line is causing the problem, but I don't know how to fix it. Running the code below as is should work fine.
However, uncomment the line # mod <- loglm( formula = reformulate(f), data = mod ), in server and you should get the same error I get.
Any help would be greatly appreciated.
ui <- fluidPage(
titlePanel("Shiny Viz!"),
fluidRow( class= "R1",
tabsetPanel(type= "pills",
tabPanel("Log-linear model",
fluidRow(
column(3, offset=1,
selectInput("model", label= "Choose model to fit:",
choices= c("(SPT)","(SP,ST,PT)","(ST,PT)","(SP,PT)","(SP,ST)")),
selectInput("type", label= "Visualise the expected or observed values?",
choices = c("observed", "expected")),
sliderInput("n_breaks", label = "Degree Celcius per bin:",
min = .5, max = 5, value = 1, step = .5)),
column(8, plotOutput("loglinear.mosaic", height= "600px") )
))))
)
library(ggplot2)
library(data.table)
library(vcd)
library(vcdExtra)
server <- function(input, output) {
# Create data
DF <- data.table( Temp = runif(5000, 0, 30),
Presence = factor(rbinom(5000, 1, runif(20, 0.1, 0.60))),
Period = factor(as.integer(runif(5000, 1, 9))) )
# Reactive expression
loglinear <- reactive({
DF[ , Temperature.category := cut_interval(Temp, length= input$n_breaks)]
Tab <- xtabs(formula= ~ Period + Temperature.category + Presence,
data = DF)
return(Tab)
})
# mosaic plot
output$loglinear.mosaic <- renderPlot({
mod <- loglinear()
f <- switch(input$model,
"(SPT)"= c("Presence*Period*Temperature.category"),
"(SP,ST,PT)" = c("Presence*Period","Presence*Temperature.category","Period*Temperature.category"),
"(ST,PT)" = c("Presence*Temperature.category","Period*Temperature.category"),
"(SP,PT)" = c("Presence*Period","Period*Temperature.category"),
"(SP,ST)" = c("Presence*Period","Presence*Temperature.category"))
# mod <- loglm( formula = reformulate(f), data = mod )
mosaic(mod,
gp= shading_hcl,
spacing = spacing_highlighting,
type= input$type,
labeling_args= list(offset_varnames = c(right = 1, left=.5),
offset_labels = c(right = .1),
set_varnames = c(Temperature.category="Temperature", Period="Period",
Presence="Status")),
set_labels=list(Presence = c("Ab","Pr")),
margins = c(right = 5, left = 3, bottom = 1, top =3))
})
}
shinyApp(ui = ui, server = server)
I still haven't found what is causing the problem with loglm, but I've figured another way of getting the result I wanted.
I used glm to fit the model instead of loglm, then used mosaic.glm from the vcdExtra package to create the mosaic plot. The code is pretty much the same except that the data as to be a data.frame and the column 'Temperature.category', 'Period' and 'Presence' must be factor to be used with glm.
However, I am still clueless as to why loglm can't find the object 'mod', but glm can? I'd realy want to know the reason. Since my answers doesn't answer that question, I'll accept an other answer if someone has an explanation.
Here's what the code using glm:
ui <- fluidPage(
titlePanel("Shiny Viz!"),
fluidRow( class= "R1",
tabsetPanel(type= "pills",
tabPanel("Log-linear model",
fluidRow(
column(3, offset=1,
selectInput("model", label= "Choose model to fit:",
choices= c("(SPT)","(SP,ST,PT)","(ST,PT)","(SP,PT)","(SP,ST)")),
selectInput("type", label= "Visualise the expected or observed values?",
choices = c("observed", "expected")),
sliderInput("n_breaks", label = "Degree Celcius per bin:",
min = .5, max = 5, value = 1, step = .5)),
column(8, plotOutput("loglinear.mosaic", height= "800px") )
))))
)
library(ggplot2)
library(data.table)
library(vcd)
library(vcdExtra)
server <- function(input, output) {
DF <- data.table( Temp = runif(5000, 0, 30),
Presence = factor(rbinom(5000, 1, runif(20, 0.1, 0.60))),
Period = factor(as.integer(runif(5000, 1, 9)) ) )
# data to data.frame format
loglinear <- reactive({
DF[ , Temperature.category := cut_interval(Temp, length= input$n_breaks)]
# add 'Freq' column
dat <- data.frame(as.table(xtabs(formula= ~ Period + Temperature.category + Presence,
data = DF)), stringsAsFactors = T)
return(dat)
})
# mosaic plot
output$loglinear.mosaic <- renderPlot({
mod <- loglinear()
f <- switch(input$model,
"(SPT)"= c("Presence*Period*Temperature.category"),
"(SP,ST,PT)" = c("Presence*Period","Presence*Temperature.category","Period*Temperature.category"),
"(ST,PT)" = c("Presence*Temperature.category","Period*Temperature.category"),
"(SP,PT)" = c("Presence*Period","Period*Temperature.category"),
"(SP,ST)" = c("Presence*Period","Presence*Temperature.category"))
# fit model using glm
mod.glm <- glm(formula = reformulate(f, response = "Freq"), data= mod, family= poisson)
mosaic.glm(mod.glm,
formula = ~ Temperature.category + Period + Presence,
gp= shading_hcl,
spacing = spacing_highlighting,
type= input$type,
labeling_args= list(rot_labels = c(left = 0, right = 0),
offset_varnames = c(left=1.5, right = 1),
offset_labels = c(left=.5, right = .1),
set_varnames = c(Temperature.category="Temperature", Period="Period",
Presence="Status")),
set_labels=list(Presence = c("Ab","Pr")),
margins = c(right = 5, left = 4, bottom = 1, top =3))
})
}