Hi,
My app is like:
shinyApp(
ui = dashboardPage(
header = dashboardHeader(disable = TRUE),
sidebar = dashboardSidebar(width = 0),
body = dashboardBody(
tags$head(
# Note the wrapping of the string in HTML()
tags$style(HTML("
@import url('https://fonts.googleapis.com/css2?family=Yusei+Magic&display=swap');
body {
background-color: black;
color: white;
}
h2 {
font-family: 'Yusei Magic', sans-serif;
}
.shiny-input-container {
color: #474747;
}"))),
### changing theme
shinyDashboardThemes(
theme = "onenote"
),
#
fluidRow(
column(12, align="center", offset = 0, style='padding:0px;',
div(img(src="Picture2.jpg", height='100%', width='100%')),
)
),
#
br(),
box(
width = 12,
title = "About",
solidHeader = TRUE,
header = TRUE,
background = NULL,
htmlOutput("about")
),
box(
width = 12,
title = "Methodology",
solidHeader = TRUE,
header = TRUE,
background = NULL,
htmlOutput("methodology")
),
fluidRow(width = 12,
background = NULL,
column(12,
glide(
height = "800x",
screen(
img(src="C1.png", height='100%', width='100%')
),
screen(
img(src="C2.png", height='100%', width='100%')
),
screen(
(img(src="C3.png", height='100%', width='100%')
),
screen(
(img(src="C4.png", height='100%', width='100%')
)
)
)))),
fluidRow( style = "background-color:#FFFAFA00;",
column(6, div(style = "font-size: 20px; padding: 0px 0px; margin-top:-2em, background-color:#FFFAFA00;"),
prettyRadioButtons("chap", label = h3("Select book chapter"),
choices = list("Chap1" = 1,
"Chap2" = 2,
"Chap3" = 3,
"Chap4" = 4),
icon = icon("check"),
bigger = TRUE,
status = "info",
animation = "smooth",
outline = TRUE)
),
column(6, div(style = "font-size: 20px; padding: 0px 0px; margin-top:-2em, background-color:#FFFAFA00;"),
prettyRadioButtons("cat", label = h3("Select category"),
choices = list("Ch" = 1, "P" = 2),
icon = icon("check"),
bigger = TRUE,
status = "info",
animation = "smooth")
)),
fluidRow( style = "background-color:#FFFAFA00;",
box(
width = 12,
solidHeader = TRUE,
header = TRUE,
background = NULL,
ui <- uiOutput("uiStub")
)
))),
server = function(input, output, session) {
observe({
if (input$chap == "1" & input$cat == "1") {
output$uiStub <- renderUI(tagList( # a single-output stub ui basically lets you
fluidPage( # move the ui into the server function
fluidRow(
column(12,
includeHTML("./html/chintaccess.html")
)
),
uiOutput("pageStub") # loaded server code should render the
) # rest of the page to this output$
))
}
else if (input$chap == "1" & input$cat == "2") {
output$uiStub <- renderUI(tagList( # a single-output stub ui basically lets you
fluidPage( # move the ui into the server function
fluidRow(
column(12,
includeHTML("./html/parintaccess.html")
)
),
uiOutput("pageStub") # loaded server code should render the
) # rest of the page to this output$
))
}
else if (input$chap == "2" & input$cat == "1") {
output$uiStub <- renderUI(tagList( # a single-output stub ui basically lets you
fluidPage( # move the ui into the server function
fluidRow(
column(12,
includeHTML("./html/onlineactchild.html")
)
),
uiOutput("pageStub") # loaded server code should render the
) # rest of the page to this output$
))
}
else if (input$chap == "2" & input$cat == "2") {
output$uiStub <- renderUI(tagList( # a single-output stub ui basically lets you
fluidPage( # move the ui into the server function
fluidRow(
column(12,
includeHTML("./html/onlineactpar.html")
)
),
uiOutput("pageStub") # loaded server code should render the
) # rest of the page to this output$
))
}
else if (input$chap == "3" & input$cat == "1") {
output$uiStub <- renderUI(tagList( # a single-output stub ui basically lets you
fluidPage( # move the ui into the server function
fluidRow(
column(12,
includeHTML("./html/onlineriskchild.html")
)
),
uiOutput("pageStub") # loaded server code should render the
) # rest of the page to this output$
))
}
else if (input$chap == "3" & input$cat == "2") {
output$uiStub <- renderUI(tagList( # a single-output stub ui basically lets you
fluidPage( # move the ui into the server function
fluidRow(
column(12,
includeHTML("./html/onlineriskpar.html")
)
),
uiOutput("pageStub") # loaded server code should render the
) # rest of the page to this output$
))
}
else if (input$chap == "4" & input$cat == "1") {
output$uiStub <- renderUI(tagList( # a single-output stub ui basically lets you
fluidPage( # move the ui into the server function
fluidRow(
column(12,
includeHTML("./html/mediachild.html")
)
),
uiOutput("pageStub") # loaded server code should render the
) # rest of the page to this output$
))
}
else if (input$chap == "4" & input$cat == "2") {
output$uiStub <- renderUI(tagList( # a single-output stub ui basically lets you
fluidPage( # move the ui into the server function
fluidRow(
column(12,
includeHTML("./html/mediapar.html")
)
),
uiOutput("pageStub") # loaded server code should render the
) # rest of the page to this output$
))
}
})
# build menu; same on all pages
output$uiStub <- renderUI(tagList( # a single-output stub ui basically lets you
fluidPage( # move the ui into the server function
fluidRow(
column(12,
includeHTML("./html/aich.html")
)
),
uiOutput("pageStub") # loaded server code should render the
) # rest of the page to this output$
))
# load server code for page specified in URL
validFiles = c("chintaccess.R", "afterconch.R", "afterconpar.R", "appwebch.R", "bullyfeelch.R") # for security (use all lower-case
# names to prevent Unix case problems)
fname = isolate(session$clientData$url_search) # isolate() deals with reactive context
if(nchar(fname)==0) { fname = "?chintaccess" } # blank means home page
fname = paste0("./plots/", substr(fname, 2, nchar(fname)), ".R") # remove leading "?", add ".R"
cat(paste0("Session filename: ", fname, ".\n")) # print the URL for this session
source(fname, local=TRUE) # load and run server code for this page
}
)
Basically every file .R contains code like:
library(tidyverse)
afterconch <- read_excel("data/afterconch.xlsx", na = "0")
# Create a "data_source" reactive variable
data_digital <- reactive({
data_digital <- afterconch %>%
gather("Frequency", "Value","Never")
return(data_digital)
})
# Already inside server
output$pageStub <- renderUI(fluidPage(
# Application title
titlePanel(h1("Wow ", align = "center")),
wellPanel(style = "background: #ffffff",
plotlyOutput("afterconch")
)
))
output$afterconch <- renderPlotly({
fig <- plot_ly(data = data_digital(),
x = ~Value,
y = ~Answer,
type = 'bar',
color = ~Frequency,
colors = brewer.pal(n = 3, "Paired")) %>%
layout(title= "When",
yaxis=list(title = "", standoff = 20L),
xaxis=list(title = "Base"),
barmode= "stack") %>% config(displaylogo = FALSE,
modeBarButtonsToRemove = list(
'sendDataToCloud',
'autoScale2d',
'resetScale2d',
'hoverClosestCartesian',
'hoverCompareCartesian'
))
})
When I run app every single plot can be run different page html generated by clicking links in files like onlineriskpar.html as below:
<p><a href="?chintaccess" target="_top">A </a></p>
<p><a href="?reaslimch" target="_blank">B</a></p>
<p><a href="?placesintch" target="_blank">C</a></p>
<p><a href="?freqintch" target="_blank">D</a></p>
My problem is that when pages are open user need to scroll them to the end to see the new plot generated.
What can I do?