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
    No fields configured for issues without a type.

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions