Skip to content

bscols and htmlwidget in R quarto #161

@antoine4ucsd

Description

@antoine4ucsd

Hello
I noticed that when using bscols for my filter_select , it impacts how htmlwidget are rendered.

for example, I have a small function to create boxes in quarto: the width of the box is as expected without bscols (first code) while the width is impacted if I include bscols

WORKING

---
title: "test plotly and crosstalk"
format: dashboard
---

```{r setup, include=FALSE}
library(plotly)
library(crosstalk)
library(dplyr)
library(lubridate)
library(sparkline)
library(htmltools)
library(leaflet)

# Function to create a static value box in RQuarto with sparklines
mybox <- function(value, title, sparkobj = NULL, subtitle,
                           info = NULL, icon = NULL, color = "#3498db", width = 4, href = NULL) {
        info_icon <- if (!is.null(info)) {
                tags$small(
                        tags$i(class = "fa fa-info-circle fa-lg",
                               title = info,
                               `data-toggle` = "tooltip",
                               style = "color: rgba(255, 255, 255, 0.75);"),
                        class = "float-right"
                )
        } else {
                NULL
        }
        
        boxContent <- div(
                class = "value-box",
                style = paste0("background-color: ", color, "; padding: 15px;
                    border-radius: 8px; color: white; text-align: center;"),
                div(
                        class = "inner",
                        tags$small(title),
                        if (!is.null(sparkobj)) info_icon,
                        h3(value, style = "margin: 10px 0; font-size: 32px;"),
                        if (!is.null(sparkobj)) div(sparkobj, style = "margin-top: 50px;"),
                        p(subtitle, style = "font-size: 14px; opacity: 0.8;")
                ),
                if (!is.null(icon)) div(class = "icon", icon, style = "font-size: 30px; margin-top: 10px;")
        )
        
        if (!is.null(href)) {
                boxContent <- a(href = href, boxContent, style = "text-decoration: none;")
        }
        
        div(
                class = paste0("col-sm-", width),
                boxContent
        )
}

set.seed(123)
df_plot <- data.frame(
  x = rnorm(100),
  y = rnorm(100)
)

sparkline <- plot_ly(df_plot) %>%
        add_lines(
                x = ~x, y = ~y,
                color = I("white"), span = I(1),
                fill = 'tozeroy', alpha = 0.2
        ) %>%
        layout(
                xaxis = list(visible = T, showgrid = F, title = ""),
                yaxis = list(visible = T, showgrid = F, title = ""),
                hovermode = "x",
                margin = list(t = 0, r = 0, l = 0, b = 0),
                font = list(color = "white"),
                paper_bgcolor = "transparent",
                plot_bgcolor = "transparent"
        ) %>%
        config(displayModeBar = F)
```


# 📊 Random Interactive Plot {orientation="columns"}


## Column {width="20%"}

### Row {height="30%"}

```{r}


mybox("world", "Hello", sparkobj = sparkline,
               subtitle = "Yes",
               info = "test", color = "#436ec1")


```

### Row {height="30%"}

```{r}



plot_ly(df_plot, x = ~x, y = ~y, type = "scatter", mode = "markers")

```

### Row {height="30%"}

```{r}

set.seed(123)
df_plot <- data.frame(
  x = rnorm(100),
  y = rnorm(100)
)

plot_ly(df_plot, x = ~x, y = ~y, type = "scatter", mode = "markers")
```


## Column {width="80%"}

```{r}

library(ggplot2)
plt<- ggplot(mtcars, aes(x = hp, y = mpg, color = factor(cyl))) +
  geom_point(size = 3) +
  labs(
    title = "Random Plot: MPG vs Horsepower",
    x = "Horsepower (hp)",
    y = "Miles per Gallon (mpg)",
    color = "Cylinders"
  ) +
  theme_minimal()
plt

```


# 🗺️ Map with Date Filter

```{r}
# Create dummy data with random dates
set.seed(1)
dummy_map_data <- data.frame(
  id = 1:10,
  lat = runif(10, 30, 50),
  lng = runif(10, -125, -70),
  date = sample(seq(as.Date("2024-01-01"), as.Date("2024-12-31"), by = "day"), 10)
)

# Share data for crosstalk filtering
shared_map_data <- SharedData$new(dummy_map_data)
```

## Row {height="10%"}


```{r}


filter_select(
        allLevels = TRUE,
        multiple = TRUE,
        id = "sp",
        label = "IDs:",
        sharedData = shared_map_data,
        group = ~id
)

```
## Row {height="90%"}

```{r}
# Leaflet map using SharedData
leaflet(shared_map_data) %>%
  addTiles() %>%
  addMarkers(~lng, ~lat, popup = ~paste("Date:", date)) %>%
  setView(lng = -95, lat = 40, zoom = 4)
```

Image

BUT this one is NOT rendering the box with the good width

---
title: "test plotly and crosstalk"
format: dashboard
---

```{r setup, include=FALSE}
library(plotly)
library(crosstalk)
library(dplyr)
library(lubridate)
library(sparkline)
library(htmltools)
library(leaflet)

# Function to create a static value box in RQuarto with sparklines
mybox <- function(value, title, sparkobj = NULL, subtitle,
                           info = NULL, icon = NULL, color = "#3498db", width = 4, href = NULL) {
        info_icon <- if (!is.null(info)) {
                tags$small(
                        tags$i(class = "fa fa-info-circle fa-lg",
                               title = info,
                               `data-toggle` = "tooltip",
                               style = "color: rgba(255, 255, 255, 0.75);"),
                        class = "float-right"
                )
        } else {
                NULL
        }
        
        boxContent <- div(
                class = "value-box",
                style = paste0("background-color: ", color, "; padding: 15px;
                    border-radius: 8px; color: white; text-align: center;"),
                div(
                        class = "inner",
                        tags$small(title),
                        if (!is.null(sparkobj)) info_icon,
                        h3(value, style = "margin: 10px 0; font-size: 32px;"),
                        if (!is.null(sparkobj)) div(sparkobj, style = "margin-top: 50px;"),
                        p(subtitle, style = "font-size: 14px; opacity: 0.8;")
                ),
                if (!is.null(icon)) div(class = "icon", icon, style = "font-size: 30px; margin-top: 10px;")
        )
        
        if (!is.null(href)) {
                boxContent <- a(href = href, boxContent, style = "text-decoration: none;")
        }
        
        div(
                class = paste0("col-sm-", width),
                boxContent
        )
}

set.seed(123)
df_plot <- data.frame(
  x = rnorm(100),
  y = rnorm(100)
)

sparkline <- plot_ly(df_plot) %>%
        add_lines(
                x = ~x, y = ~y,
                color = I("white"), span = I(1),
                fill = 'tozeroy', alpha = 0.2
        ) %>%
        layout(
                xaxis = list(visible = T, showgrid = F, title = ""),
                yaxis = list(visible = T, showgrid = F, title = ""),
                hovermode = "x",
                margin = list(t = 0, r = 0, l = 0, b = 0),
                font = list(color = "white"),
                paper_bgcolor = "transparent",
                plot_bgcolor = "transparent"
        ) %>%
        config(displayModeBar = F)
```


# 📊 Random Interactive Plot {orientation="columns"}


## Column {width="20%"}

### Row {height="30%"}

```{r}


mybox("world", "Hello", sparkobj = sparkline,
               subtitle = "Yes",
               info = "test", color = "#436ec1")


```

### Row {height="30%"}

```{r}



plot_ly(df_plot, x = ~x, y = ~y, type = "scatter", mode = "markers")

```

### Row {height="30%"}

```{r}

set.seed(123)
df_plot <- data.frame(
  x = rnorm(100),
  y = rnorm(100)
)

plot_ly(df_plot, x = ~x, y = ~y, type = "scatter", mode = "markers")
```


## Column {width="80%"}

```{r}

library(ggplot2)
plt<- ggplot(mtcars, aes(x = hp, y = mpg, color = factor(cyl))) +
  geom_point(size = 3) +
  labs(
    title = "Random Plot: MPG vs Horsepower",
    x = "Horsepower (hp)",
    y = "Miles per Gallon (mpg)",
    color = "Cylinders"
  ) +
  theme_minimal()
plt

```


# 🗺️ Map with Date Filter

```{r}
# Create dummy data with random dates
set.seed(1)
dummy_map_data <- data.frame(
  id = 1:10,
  lat = runif(10, 30, 50),
  lng = runif(10, -125, -70),
  date = sample(seq(as.Date("2024-01-01"), as.Date("2024-12-31"), by = "day"), 10)
)

# Share data for crosstalk filtering
shared_map_data <- SharedData$new(dummy_map_data)
```

## Row {height="10%"}


```{r}

bscols(
  widths = c(3, 6, 3),
  "",
filter_select(
        allLevels = TRUE,
        multiple = TRUE,
        id = "sp",
        label = "IDs:",
        sharedData = shared_map_data,
        group = ~id
),
  ""
)

```
## Row {height="90%"}

```{r}
# Leaflet map using SharedData
leaflet(shared_map_data) %>%
  addTiles() %>%
  addMarkers(~lng, ~lat, popup = ~paste("Date:", date)) %>%
  setView(lng = -95, lat = 40, zoom = 4)
```

Image

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions