So I'm trying to create a shiny app to visualize some probability functions. I've got an old version (which works) with some very heavy code and now I want to update it using the switch functions. But my plot does not seem to respond very well to that.
I've tried to use the req() function to force the update of the data. But then I thought that maybe the problem was I just can't use the same name for the plot in two panels.
ui <- dashboardPage(
dashboardHeader(title = "probability laws"),
dashboardSidebar(
sidebarMenu(id='menus',
menuItem(text = "Plotting some densities" , icon = icon("atlas"),tabName = "density"),
menuItem(text = "repartition functions", icon = icon("cog", lib = 'glyphicon'),tabName = "repartition")
)
),
dashboardBody(
tabItems(
tabItem("density",
fluidRow(
tabsetPanel(id = 'tabs',
tabPanel(title='uniforme',value='unif',fluidRow(
column(8, plotOutput('graphe')),
column(3,wellPanel(
sliderInput(inputId = "inf",label = "borne inf",min = -10,max = 10,value = 0,step = 0.2),br(),
sliderInput(inputId = "sup",label = "borne sup",min = -10,max = 10,value = 1,step = 0.2),br())
))),
tabPanel(title='normale',value='norm',fluidRow(
column(8, plotOutput('graphe')),
column(3,wellPanel(
sliderInput(inputId = "mu",label = "mean",min = -10,max = 10,value = 0,step = 0.2),br(),
sliderInput(inputId = "var",label = "variance",min = 0,max = 10,value = 1,step = 0.2),br())
)))
)
)))))
And in the server:
server <- function(input, output,session) {
x <- reactive({switch (input$tabs,
'unif' = seq(-10,10,0.1),
'norm' = seq(-10,10,0.1)
)})
data <- reactive({switch(input$tabs,
'unif' = dunif(x(),0,1),
'norm' = dnorm(x(),0,1)
)})
data2 <- reactive({switch(input$tabs,
'unif' = dunif(x(),min(input$inf, input$sup),max(input$inf,input$sup)),
'norm' = dnorm(x(), input$mu, sqrt(input$var))
)})
output$graphe <- renderPlot({df <- melt(data.frame(x(),data(),data2()), id='x..')
ggplot(data=df, aes(x=x.., y=value, colour=variable)) + geom_line() + xlim(-10,10) + ylim(0,1) + theme(legend.position = 'none')
})
}
The thing is R doesn't find any error, and if I just keep the unif part it works. But when I add the normal distribution panel I'm left with a blank space.
Any help is greatly appreciated.
So with some research I solved this by using graphe1 and graph2 like :
output$graphe1 <- output$graphe2 <- renderPlot(...)
Thank you #Stéphane_Laurent for pointing out where the mistake was.
Related
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))
I am able to take input dates from the user and but can't make it wait to execute after entering the dates.
library(shiny)
library(ggplot2)
library(quantmod)
# Define UI for application that draws a bar graph
ui <- fluidPage(
# Application title
titlePanel("My Plot"),
sidebarLayout(
sidebarPanel(
textInput("text", "Enter company name:", width = NULL,
placeholder = "comp.name"),
dateRangeInput("dates", h3(strong("Date Range")),
start = "2001-01-01", end = Sys.Date(),
min = "0000-01-01", max = Sys.Date(),
format = "dd-mm-yy", separator = strong("to"),
autoclose = TRUE),
submitButton(text = "submit")),
# Show a plot
mainPanel( h1(strong(textOutput("Company"))),
tableOutput("MRF"),
plotOutput("finally")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$MRF <- renderTable({
tyu2 <- getSymbols(input$text , src = "yahoo", verbose = TRUE,
from = min(input$date) , to = max(input$date), auto.assign = FALSE)})
output$finally <- renderPlot({ggplot(data = tyu2 , aes(x= x ,y=tyu))+
geom_bar(stat = "identity", fill = "blue")+
theme(axis.text.x = element_text(angle = 90)) +
xlab("Dates")+ ylab(comp.name)})
}
# Run the application
shinyApp(ui = ui, server = server)
The dates must be going in as infinity which is the default case when the dates are not being read. I am not understanding what is wrong. Could anybody help me out. Thank you
If you run the R shiny script below, we get two boxes in a dashboard, the left box has a bar chart and right has a DT table, when I click on any bar of the chart using event_data("plotly_click"), I want the corresponding Employee to be displayed in the table besides, like when clicked on first bar, "r1" should be displayed in the table besides. I tried doing "user_cases$base1[d[3]]" but it throws an error as "Error: invalid subscript type 'list'". I will attach the snapshot for the reference, please help me with the same.
## app.R ##
library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Sankey Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader =
T,
plotlyOutput("sankey_plot")),
box( title = "Case Summary", status = "primary", height = "455",solidHeader
= T,
dataTableOutput("sankey_table"))
)
)
server <- function(input, output)
{
output$sankey_plot <- renderPlotly({
height2 = c(56,45,23,19,8)
base1 = c("r1","r4","r2","r5","r3")
user_cases = data.frame(base1,height2)
pp1 <<- ggplot(user_cases, aes(x = reorder(base1,-height2), y = height2)) +
geom_bar(stat = "identity", fill = "#3399ff" ) + scale_y_discrete(name
="Cases") + scale_x_discrete(name = "Employee")
ggplotly(pp1, tooltip="text",height = 392)
})
output$sankey_table <- renderDataTable({
d <- event_data("plotly_click")
user_cases$base1[d[3]]
})
}
shinyApp(ui, server)
Dataset to be fetched
I am trying to fetch subset of the data from the patients dataset from bupaR library. The code for doing it is as follows:
patients_final <- patients[patients$employee == as.data.frame(
user_time$employee[as.numeric(d[3])])]
but the error I get is: "Can't use matrix or array for column indexing" attaching the snapshot for the help.
Have a look at the modified code, I have changed user_cases$base1[d[3]] to as.data.frame(user_cases$base1[as.numeric(d[3])])
## app.R ##
library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(DT)
height2 = c(56,45,23,19,8)
base1 = c("r1","r4","r2","r5","r3")
user_cases = data.frame(base1,height2)
ui <- dashboardPage(
dashboardHeader(title = "Sankey Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader =
T,
plotlyOutput("sankey_plot")),
box( title = "Case Summary", status = "primary", height = "455",solidHeader
= T,
dataTableOutput("sankey_table"))
)
)
server <- function(input, output)
{
output$sankey_plot <- renderPlotly({
pp1 <<- ggplot(user_cases, aes(x = reorder(base1,-height2), y = height2)) +
geom_bar(stat = "identity", fill = "#3399ff" ) + scale_y_discrete(name
="Cases") + scale_x_discrete(name = "Employee")
ggplotly(pp1, tooltip="text",height = 392)
})
output$sankey_table <- renderDataTable({
d <- event_data("plotly_click")
as.data.frame( user_cases$base1[as.numeric(d[3])])
})
}
shinyApp(ui, server)
The output is as below:
You can modify the dataframe output as per your requirement.
Hope it helps!
I have this shiny code and the plot is not showing for some reason. Can you please extend me a hand?
Is a basic shiny plot to render in the Main Panel. Checked loads of times and still not plotting.
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
(titlePanel("APP & MEP | Size (m2) ~ Hours", windowTitle = "app")),
sidebarLayout(
sidebarPanel(
checkboxGroupInput(inputId = "checkgroup",
label = "Select Deparments",
choices = c("All", "ELE", "HVAC", "MAN", "PH", "LV"),
selected = "All", inline = F),
radioButtons(inputId = "radio",
label = "ADD Stat_Smooth?",
choices = c("YES","NO"),
inline = T),
sliderInput(inputId = "slider",
label = "SPAN Setting",
min = 0.2, max = 2, value = 1,
ticks = T)
),
mainPanel(plotOutput(outputId = "plot33"))
)
)
server <- function(input, output){
output$plot33 <- renderPlotly({
gg <- ggplot(sizedf, aes(SIZE, Hours)) + geom_point(aes(color = Department)) + ggtitle("Size(m2) vs Hours per department")
p <- ggplotly(gg)
p
})
}
shinyApp(ui = ui, server = server)
I have seen this same mistake a few time already.
plotlyOutput() should be used, not plotOutput()
Example might look long but it's really simple.
My issue is around having a reactive object and the use of <<-.
I have another shiny app which works great using:
blah <- reactive({
dat <<- etcetc
)
And then successfully using dat later in dataTable and plot components. But with the below I'm failing hard.
Question: What is the difference between item1 <- reactive({etc}) and item2 <<- etc
As I understand it, you can put a reactive dataset into an object (item1) and then use it later by putting item1() in your code. The scoping rules suggest you can use item2 <<- etc and then just use item2 later in your code.
contents2 <- reactive({
datp <- data.frame(mean = c(r1, r2),
chosen = c(rep("A", length(r1)), rep("B", length(r2))))
datp
})
I know I can break up my code below into the form above (with datp and datci being their own reactive objects (say contents2 and contents3), and it works) but shouldn't the scoping <<- below work?
Example:
library(ggplot2)
ui <- navbarPage("Test",
tabPanel("Panel A",
sidebarLayout(
sidebarPanel(
sliderInput("n1", "N sample 1:",
min=2, max=30, value=3),
sliderInput("n2", "N sample 2:",
min=2, max=30, value=3),
numericInput("mean1", label = h5("Mean 1"), value = 100),
numericInput("mean2", label = h5("Mean 2"), value = 80),
numericInput("sd1", label = h5("Std Dev 1"), value = 10),
numericInput("sd2", label = h5("Std Dev 2"), value = 10),
radioButtons("cilevel", "Confidence Interval",
c("99%" = 0.99,
"95%" = 0.95,
"90%" = 0.90),
selected = 0.95)
)
,
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Panel B",
sidebarLayout(
sidebarPanel(
)
,
mainPanel(
)
)
)
)
server <- function(input, output, session) {
contents1 <- reactive({
r1 <- rnorm(input$n1, input$mean1, input$sd1)
r2 <- rnorm(input$n2, input$mean2, input$sd2)
# Note the change to << now
cimult <<- qt(as.numeric(input$cilevel)/2 + .5, length(r1))
datp <<- data.frame(mean = c(r1, r2),
chosen = c(rep("A", length(r1)), rep("B", length(r2))))
datci <<- data.frame(mean = c(mean(r1), mean(r2)),
sd = c(sd(r1), sd(r2)),
n = c(length(r1), length(r2)),
se = c(sd(r1)/sqrt(length(r1)), sd(r2)/sqrt(length(r2))),
chosen = c("A", "B"))
})
output$plot <- renderPlot({
ggplot(datci, aes(x = factor(chosen),
y = mean)) +
geom_errorbar(aes(ymin = mean - cimult * se,
ymax = mean + cimult * se,
color = factor(chosen))) +
geom_point(aes(color = factor(chosen)), alpha = 0.8) +
geom_point(data = contents1(), alpha = 0.8) +
coord_flip()
})
}
shinyApp(ui = ui, server = server)