I want to create a simple R shiny app that would let a person choose few things :
a) How many years (trials) we want to test?
b) What we want to test (b.1 - GDP,b.2 - Life Expectancy,b.3 - Happiness)
c) According to the chosen b) variable, I would like to take different probability functions.
For example, if Life expectancy is chosen, p(x)=(80-x)*0.0025+0.02, and then I would like to have a cumulative distribution graph shown. I took code from google, tried updating it but it didn't work so i would appreciate your help..
library(shiny)
# Define UI for application that draws a probability plot
shinyUI(fluidPage(
# Application title
titlePanel("Cumulative Binomial Probability Plot"),
# Sidebar with a slider input for value of lambda
sidebarLayout(
sidebarPanel(
sliderInput("lambda",
"age you want to reach",
min = 75,
max = 100,
value = 1)
),
# Show a plot of the generated probability plot
mainPanel(
plotOutput("ProbPlot")
)
)
))
# SERVER
library(shiny)
library(ggplot2)
library(scales)
# Shiny Application
shinyServer(function(input, output) {
# Reactive expressions
output$ProbPlot <- renderPlot({
# generate lambda based on input$lambda from ui.R
l=0:1
lambda <- seq(min(l), max(l), length.out = input$lambda)
probability=(80-lambda)*0.0025+0.02
# generate trials based on lambda value
powers=0.00025
muCalculation <- function(lambda, powers) {(80-lambda)*powers+0.002}
probability_at_lambda <- sapply(input$lambda, muCalculation, seq(75, 100, 1))
# draw the probability
par(bg = '#191661', fg = '#ffffff', col.main = '#ffffff', col.lab = '#ffffff', col.axis =
'#ffffff')
plot(probability_at_lambda,type="o",col="#b1aef4", xlab="N", ylab="Probability",
xlim=c(75, 100), ylim=c(0.0, 1.0), pch=19)
title(main="Cumulative Binomial Probability")
})
})
It's not clear to me what you want to do. But the R stats package has an empirical cumulative distribution function ecdf which you can plot. See the help ?ecdf to get details on how it works. E.g,
x <- rnorm(1000)
xcdf <- ecdf(x)
plot(xcdf)
Related
I am trying to render some boxplots in R shiny through selectiveinput. I have my options, but when I run the app it just says cant find object and wont render. Here is my ui code, plotoutput is "boxplot":
selectInput(inputId = "Input3", "Boxplot:",
choices = c(label = NULL,
'Gunning Fog Index'= 'gfi',
'Percentage of hard words'= 'pohw',
'Flesch Readability Ease' = 'flesch',
'Automated Readability Index' = 'ari',
'Percentage of first person pronouns' = 'pofpp',
'Percentage of third person pronouns' = 'potpp')),
Here is my server code:
output$boxplot <- renderPlot({
par(mfrow=c(1, 2))
# generate bins based on input$bins from ui.R
boxplot(get(input$Input3), Flesch_fake, ylim = c(-20, 60), col = "red", main="Flesch Reading Ease - Fake")
})
If I try to use $flesch after Input3 in the renderPlot function, it says that the operator is invalid for atomic vectors. How can I get through this and just simply render a boxplot through SelectiveInput? The app itself works it just doesn't render the boxplots.
This is my first attempt at using Shiny.
I have a simulated patient-level dataset with 4 variables:
group: Categorical, takes on values A, B and C. Represents 3 different treatment types that were used in the study.
week: Numeric variable, takes on values 1, 4, 8.Represents follow-up week.
painscore: Numeric variable, score on scale of 1-10, with 1 indicating no pain, 10 indicating extreme pain.
dependscore: Numeric variable, score on scale of 1-10, with 1 indicating no dependency on pain meds, 10 indicating extreme dependency.
Trying to build a simple app that accepts two inputs: the week, and the variable, and provides two outputs:
A boxplot of distribution of scores for the selected variable for the selected week. The x axis would represent the 3 levels of group (A, B and C).
A summary table the shows the number of observations, median, 25th percentile, 75th percentile and number of missing.
I was able to create the interactive boxplot, but I am unable to create the summary table. I was able to create static versions of this table in RMarkdown using the summaryBy function from doBy, but I am not able to implement it in Shiny. Tried following the advice here and here but I'm missing something.
Here's my code for reproducibility. Excuse the extensive annotations, (I'm a complete beginner) they are more for myself than for anyone else.
#libraries--------------------
library(shiny)
library(tidyverse)
library(knitr)
library(doBy)
#----------------------------
#input data
set.seed(123)
mydf <- data.frame( group = rep(rep(c("A","B","C"), each = 3), times = 3),
week = rep(rep(c(1,4,8), each = 9)),
painscore = sample(1:10, 27, replace = TRUE),
dependscore = sample(1:10, 27, replace = TRUE) )
#--------------------------
#define custom function to calculate summary statistics for column of interest.
#function explained in a little more detail when applied in the server function.
fun <- function(x) {
c( n = length(x),
m = median(x),
firstq = round(quantile(x)[2], 1),
lastq = round(quantile(x)[4], 1),
missing = mean(is.na(x)))
}
#-------------------------
#UI
ui <- fluidPage(
titlePanel("Shiny Boxplot and Table"),
#User can provide two different inputs
sidebarLayout(
sidebarPanel(
#1. allow user to pick week using radiobuttons
radioButtons(inputId = "pickedwk",
label = "week you want to display",
choices = c(1,4,8),
selected = 1),
#2. user can pick variable to visualize using dropdownboxes
selectInput(inputId = "var",
label = "variable to visualize",
list("How much pain did you feel today?" = "painscore",
"How dependent are you on medication?" = "dependscore")),
#helpertext
helpText("Enter week/variable choices here")
),
#Spaceholders for output
mainPanel(
plotOutput("boxplot"), #boxplot placeholder
htmlOutput("descriptives") #kable html table placeholder
)
)
)
#-------------------------
#Server
server <- function(input, output) {
#create dataset that subsets down to the week picked by user.
weeksub <- reactive({
mydf %>% filter(week == input$pickedwk[1])
})
#1. use reactive datasubset to render boxplot.
output$boxplot <- renderPlot({
ggplot(weeksub(), aes_string(x = "group", y = input$var)) + #input$var works here
geom_boxplot(fill = "red", outlier.shape = 15, outlier.color = "black") +
scale_y_continuous(name = as.character(input$var)) +
scale_x_discrete(name = "group") +
ggtitle(paste("Distribution of", as.character(input$var), "by treatment group"))
})
#2. use same reactive datasubset to render kable descriptive statistics for the variable picked.
output$descriptives <- renderText({
kable(summaryBy(input$var ~ group, data = as.data.frame(weeksub()), FUN = fun),
#note: here, I'm using the summaryBy function from package doBy. It takes the form var~ categoricalvar
# so, either painscore ~ group, or dependscore ~ group depending on what the user picked, and uses
#my custom function to return a table of count, median, 25th percentile, 75th percentile and missing count for
#the 3 levels of the group variable (for A, B, and C)
col.names = c("Number", "Median", "1Q", "3Q", "Missing"))
})
}#server function ends
# Run the application
shinyApp(ui = ui, server = server)
There are a couple of problems in your code:
The formula notation doesn't know how to deal with input$var. summaryBy supports an alternate syntax that works better. (You could also use as.formula and paste to build a formula.)
You are missing the "Group" column in col.names
You have to generate HTML from kable and pass it as HTML to the UI.
Change your table output to this:
output$descriptives <- renderUI({
HTML(kable(summaryBy(list(input$var, 'group'), data = as.data.frame(weeksub()), FUN = fun),
col.names = c('Group', "Number", "Median", "1Q", "3Q", "Missing"),
format='html'
))
})
I've written a Shiny app that allows the user to select two points on a raster, resulting in the computation of a route using different parameters.
The visualisation of the route is only one component I want to happen. I also want to be able to create summary statistics of the route and show these in a different plot (so the route is shown on the left, and the statistics on the right).
However, I'm not sure how to make the route accessible within another Plot. What I want to be accessible to the other Plot is the
elevation <- data.frame(extract(dem, AtoB4))
Elevation will then be used to create the summary statistics that will be shown in the right column.
Any thoughts on how to do this is appreciated. Recommendations of a different way to do it completely is also appreciated.
Reproducible example:
ui.R
# Define UI for application that plots features of movies
ui <- fluidPage(
titlePanel("xx"),
# Sidebar layout with a input and output definitions
fluidRow(
# Inputs
column(width = 2,
p("Drag a box on the Elevation plot to generate Least Cost Paths using different number of neighbours"),
p("Least Cost Path generated using",strong("4 neighbours"), style = "color:red"),
p("Least Cost Path generated using",strong("8 neighbours"), style = "color:black"),
p("Least Cost Path generated using",strong("16 neighbours"), style = "color:blue")
),
# Outputs
column(4,
plotOutput(outputId = "mapPlot", brush = "plot_brush")
),
column(6,
plotOutput(outputId = "stats_plots"))
)
)
server.R
library(shiny)
library(raster)
library(gdistance)
library(sp)
library(rgdal)
dem <- raster(system.file("external/maungawhau.grd", package="gdistance"))
# Define server function required to create the scatterplot
conductance_calc <- function(input_dem, neighbours) {
altDiff <- function(x){x[2] - x[1]}
hd <- transition(input_dem, altDiff, neighbours, symm=FALSE)
slope <- geoCorrection(hd)
adj <- adjacent(input_dem, cells=1:ncell(input_dem), pairs=TRUE, directions=16)
speed <- slope
speed[adj] <- 6 * exp(-3.5 * abs(slope[adj] + 0.05))
Conductance <- geoCorrection(speed)
return(Conductance)
}
server <- function(input, output) {
output$mapPlot <- renderPlot( {
plot(dem, axes = FALSE, legend = FALSE)
Conductance <-conductance_calc(dem, 16)
if(is.null(input$plot_brush)) return("NULL\n")
A <- c(as.numeric(unlist(input$plot_brush))[1], as.numeric(unlist(input$plot_brush))[3])
B <- c(as.numeric(unlist(input$plot_brush))[2], as.numeric(unlist(input$plot_brush))[4])
AtoB16 <- shortestPath(Conductance, A, B, output="SpatialLines")
###
Conductance <- conductance_calc(dem, 8)
if(is.null(input$plot_brush)) return("NULL\n")
A <- c(as.numeric(unlist(input$plot_brush))[1], as.numeric(unlist(input$plot_brush))[3])
B <- c(as.numeric(unlist(input$plot_brush))[2], as.numeric(unlist(input$plot_brush))[4])
AtoB8 <- shortestPath(Conductance, A, B, output="SpatialLines")
###
Conductance <-conductance_calc(dem, 4)
if(is.null(input$plot_brush)) return("NULL\n")
A <- c(as.numeric(unlist(input$plot_brush))[1], as.numeric(unlist(input$plot_brush))[3])
B <- c(as.numeric(unlist(input$plot_brush))[2], as.numeric(unlist(input$plot_brush))[4])
AtoB4 <- shortestPath(Conductance, A, B, output="SpatialLines")
####
plot(dem, axes = FALSE, legend = FALSE)
lines(AtoB4, col = "red")
lines(AtoB8, col = "black")
lines(AtoB16, col = "blue")
elevation <<- data.frame(extract(dem, AtoB4))
names(elevation) <- "metres"
})
output$stats_plots <- renderPlot( {
})
}
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 want to assign the position in a plot if a condition is TRUE in R.
I am using shiny R package. in the Server.R the codes are as following:
output$plotmahal<-renderPlot({
#identify the current position of project
x0<-subset(x1,Type==1)
xc<-x0[,c(input$KPI1,input$KPI2)]
#change list to integer
xc1<-as.numeric(unlist(xc))
#current point
d0<-xc1[1]
d1<-xc1[2]
#Centroid point
centroid<-colMeans(x[,c(input$KPI1,input$KPI2)])
c0<-centroid[1]
c1<-centroid[2]
#Quantile of .5 to show if the current is inside 50% of benchmark space or not
xq<-subset(x1,Type!=1)
qKPI1high<-quantile(xq[,input$KPI1],1)
qKPI2high<-quantile(xq[,input$KPI2],1)
qKPI1low<-quantile(xq[,input$KPI1],0)
qKPI2low<-quantile(xq[,input$KPI1],0)
if((d0>qKPI1low && d0<qKPI1high) && (d1>qKPI2low && d1<qKPI2high))
{currentstatus<-"Within Benchmark"}
else{
currentstatus<-"out of benchmark"}
output$c0<-renderText({
paste(currentstatus,input$currentstatus)
})
segments(d0,d1,c0,c1,col='brown',cex=10)
})
output$dss<-renderPlot({
if(is.element("out of benchmark",input$currentstatus)){
x<-c(1)
y<-c(1)
}
if(is.element("within benchmark",input$currentstatus)){
x<-c(1)
y<-c(2)
}
plot(x,y,xaxt='n',yaxt='n',cex=1,pch=19,col=ifelse(x==1,"red","green"),ylab="status",xlab="period")
axis(1,at=1:2,labels=c("t1","t2"))
axis(2,at=1:2,labels=c("within benchmark","out of bench"))
})
If the first condition is TRUE Assign the position of (1,1) in the graph to the point.witch will be in the position of (t1,Within benchmark) in the axis of of x and y respectively.
But it does not assign it.
If you want to change the value of currentstatus from within a reactive component, it should be a reactive value itself. Here is an example where a reactiveValues element is used to store currentstatus. It is updated from within one renderPlot and used in another, as in your code.
In this example, the value of currentstatus changes when the line crosses the color barrier.
## Sample data
dat <- mtcars
library(shiny)
shinyApp(
shinyUI(
fluidPage(
wellPanel(
radioButtons('column', 'Column:', choices=names(dat),
selected='mpg', inline=TRUE),
uiOutput('ui')
),
mainPanel(
fluidRow(column(8, plotOutput('plotmahal')),
column(4, plotOutput('dss')))
)
)
),
shinyServer(function(input, output){
## Reactive values
vals <- reactiveValues(currentstatus = 'Within')
## The input options
output$ui <- renderUI({
list(
sliderInput('inp', 'Range:', min=0, max=max(dat[[input$column]]),
value=mean(dat[[input$column]])),
helpText('Example: when the line crosses the color barrier, currenstatus changes.',
align='center', style='font-weight:800;')
)
})
output$plotmahal <- renderPlot({
## Update the value of currentstatus when the input is < or > the mean
mu <- mean(dat[[input$column]])
vals$currentstatus <- if (input$inp < mu) 'Within' else 'Out'
## Make a random graph
counts <- hist(dat[[input$column]], plot=FALSE)
image(x=seq(0, mu, length=20), (y=seq(0, max(counts$counts), length=20)),
(z=matrix(rnorm(400), 20)), col=heat.colors(20, alpha=0.5),
xlim=c(0, max(counts$breaks)), xlab='', ylab='')
image(x=seq(mu, max(counts$breaks), length=20), y=y, z=z,
col=colorRampPalette(c('lightblue', 'darkblue'), alpha=0.5)(20), add=TRUE)
abline(v = input$inp, lwd=4, col='firebrick4')
})
output$dss <- renderPlot({
## This prints the currentstatus variable to RStudio console
print(vals$currentstatus)
if(is.element("Out", vals$currentstatus))
x <- y <- 1
if(is.element("Within", vals$currentstatus)) {
x <- 1
y <- 2
}
plot(x, y, xaxt='n',yaxt='n',cex=1,pch=19,
col=ifelse(x==1,"red","green"),ylab="status",xlab="period",
xlim=c(0,3), ylim=c(0,3))
axis(1,at=1:2,labels=c("t1","t2"))
axis(2,at=1:2,labels=c("within benchmark","out of bench"))
})
})
)