Flexdashboard and absolute panel on a lealfet - shiny

Question

Is there a way to include an absolute panel like in this example (https://shiny.rstudio.com/gallery/superzip-example.html) to a flexdashboard (on a leaflet) ?
The idea would be to have a mobile panel dedicated to the leaflet output instead of a sidebar panel.
The absolute panel example here based on a shiny example (with ui and server parts)
library(shiny)
ui <- shinyUI(bootstrapPage(
absolutePanel(
id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
HTML('<button data-toggle="collapse" data-target="#demo">Collapsible</button>'),
tags$div(id = 'demo',
checkboxInput('input_draw_point', 'Draw point', FALSE ),
verbatimTextOutput('summary')))
))
server <- shinyServer(function(input, output, session) {
output$summary <- renderPrint(print(cars))
})
shinyApp(ui = ui, server = server)
a code example below for the Flexdashboard part :
---
title: "Waste Lands - America's forgotten nuclear legacy"
author: Philipp Ottolinger
output:
flexdashboard::flex_dashboard:
theme: journal
social: menu
source_code: embed
---
```{r setup, include = FALSE}
library(flexdashboard)
library(shiny)
library(jsonlite)
library(maptools)
library(ggplot2)
library(tidyr)
library(dplyr)
library(purrr)
library(leaflet)
library(plotly)
sites <- fromJSON(flatten=TRUE,
"https://raw.githubusercontent.com/ottlngr/2016-15/ottlngr/ottlngr/sites.json")
sites$locations <- map(sites$locations, function(x) {
if (nrow(x) == 0) {
data_frame(latitude=NA, longitude=NA, postal_code=NA, name=NA, street_address=NA)
} else {
x
}
})
sites <- unnest(sites)
sites <- sites[complete.cases(sites[,c("longitude", "latitude")]),]
sites$ratingcol <- ifelse(sites$site.rating == 0, "orange",
ifelse(sites$site.rating == 1, "green",
ifelse(sites$site.rating == 2, "red", "black")))
sites$ratingf <- factor(sites$site.rating,
levels=c(3:0),
labels=c("Remote or no potential for radioactive contamination.",
"No authority to clean up or status unclear.",
"Cleanup declared complete.",
"Cleanup in progress."))
sites$campus <- ifelse(grepl("University", sites$site.name) |
grepl("University", pattern = sites$street_address) |
grepl("Campus", sites$street_address), 1, 0)
sites$campuscol <- ifelse(sites$campus == 1, "red", "black")
```
Column {data-width=650}
-----------------------------------------------------------------------
### All sites and their current status
```{r}
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addCircleMarkers(sites$longitude,
sites$latitude,
color = sites$ratingcol,
radius = 6,
fill = T,
fillOpacity = 0.2,
opacity = 0.6,
popup = paste(sites$site.city,
sites$site.name,
sep = "")) %>%
addLegend("bottomleft",
colors = c("orange","green", "red", "black"),
labels = c("Cleanup in progress.",
"Cleanup complete.",
"Status unclear.",
"No potential for radioactive contamination."),
opacity = 0.8)
```
Column {data-width=350}
-----------------------------------------------------------------------
### Number of sites
```{r}
sites %>%
count(ratingf) %>%
plot_ly(type = "bar",
x = ratingf,
y = n,
color = ratingf,
text = paste(n,ratingf,sep=""),
hoverinfo = "text") %>%
layout(xaxis = list(showline = F,
showticklabels = F,
fixedrange = T,
title = ""),
yaxis = list(fixedrange = T,
title = ""))
```
### Sites on campus
```{r}
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addCircleMarkers(sites[sites$campus == 1, ]$longitude,
sites[sites$campus == 1, ]$latitude,
color = sites[sites$campus == 1, ]$campuscol,
radius = 6,
fill = T,
fillOpacity = 0.2,
opacity = 0.6,
popup = paste(sites[sites$campus == 1, ]$site.city,
sites[sites$campus == 1, ]$site.name,
sep = ""))
```
Thanks

Answer 1

Try this.
---
title: "haha"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
editor_options:
chunk_output_type: console
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(flexdashboard)
library(shiny)
library(leaflet)
```
# without container-fluid
### Sites on campus
```{r}
df <- data.frame(NY = c(-74.418997, 43.257408), CA = c(-120.765285, 35.604380))
renderLeaflet(mapfunction())
```
```{r}
absolutePanel(
draggable = TRUE, top = "15%", left = "auto", right = "5%", bottom = "auto",
width = '30%', height = 'auto',
style = "background: orange; opacity: 0.9",
p(strong("some text")),
selectInput("someinput", label = "location", choices = c("NY", "CA"))
)
```
### server
```{r}
mapfunction <- reactive({
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addMarkers(lng = df[[input$someinput]][1], lat = df[[input$someinput]][2])
})
```
# with container-fluid
```{r}
shinyApp(
fluidPage(
leafletOutput(outputId = "somemap"),
absolutePanel(
draggable = TRUE, top = "15%", left = "auto", right = "5%", bottom = "auto",
width = '30%', height = 'auto', fixed = TRUE,
style = "background: orange; opacity: 0.9",
p(strong("some text")),
selectInput("someinput", label = "location", choices = c("NY", "CA"))
)
),
server = function(input, output, session){
df <- data.frame(NY = c(-74.418997, 43.257408), CA = c(-120.765285, 35.604380))
output$somemap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(-127.44,24.05,-65.30,50.35) %>%
addMarkers(lng = df[[input$someinput]][1], lat = df[[input$someinput]][2])
})
}
)
```
If you need to use interactive components from shiny, like XXinput, you need to specify runtime: shiny on the top, otherwise, you can delete this line.
I use reactive as the simplest server part. If you want to use a more complex server (logic), e.g. several components interact together, you need to write the actual server function. I would suggest just write a shiny app instead of a flexdashboard.
unfortunately, components in flexdash are not inside container-fluid class which with this can allow you to drag the panel. There may be a way to work around, you can search for it. Look at the last chunck, I inserted a actual shiny app and the panel is draggable. You should see two tabs when you run the doc, watch the difference. So, if you really want to drag this panel, you should write a "real" shiny app.