pkgnet-gallery.Rmd

---
title: "Gallery"
output: 
    rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Gallery}
  %\VignetteEngine{}
  %\VignetteEncoding{UTF-8}
---

Welcome to the **pkgnet** gallery!   Click any item below to see an example report.  Go to the [gallery github page](https://github.com/uptake/pkgnet-gallery) to contribute. 

```{r exhibit_data, include = FALSE}
exhibitsList <- list(
    list(
        package_name = "pkgnet"
        , report_url = "https://uptake.github.io/pkgnet-gallery/exhibits/pkgnet/pkgnet.html"
        , image_url = "https://uptake.github.io/pkgnet-gallery/exhibits/pkgnet/pkgnet.png"
    )
    , list(
        package_name = "pkgnet (Vignette)"
        , report_url = "https://uptake.github.io/pkgnet-gallery/exhibits/pkgnet-vignette/pkgnet-vignette.html"
        , image_url = "https://uptake.github.io/pkgnet-gallery/exhibits/pkgnet/pkgnet.png"
    )
    , list(
        package_name = "bingo"
        , report_url = "https://uptake.github.io/pkgnet-gallery/exhibits/bingo/bingo.html"
        , image_url = "https://uptake.github.io/pkgnet-gallery/exhibits/bingo/bingo.png"
    )
    , list(
        package_name = "data.table"
        , report_url = "https://uptake.github.io/pkgnet-gallery/exhibits/data_table/data_table.html"
        , image_url = "https://uptake.github.io/pkgnet-gallery/exhibits/data_table/data_table.png"
    )
    , list(
        package_name = "ggplot2"
        , report_url = "https://uptake.github.io/pkgnet-gallery/exhibits/ggplot2/ggplot2.html"
        , image_url = "https://uptake.github.io/pkgnet-gallery/exhibits/ggplot2/ggplot2.png"
    )
    , list(
        package_name = "lubridate"
        , report_url = "https://uptake.github.io/pkgnet-gallery/exhibits/lubridate/lubridate.html"
        , image_url = "https://uptake.github.io/pkgnet-gallery/exhibits/lubridate/lubridate.png"
    )
    , list(
        package_name = "pipecleaner"
        , report_url = "https://uptake.github.io/pkgnet-gallery/exhibits/pipecleaner/pipecleaner.html"
        , image_url = "https://uptake.github.io/pkgnet-gallery/exhibits/pipecleaner/pipecleaner.png"
    )
    , list(
        package_name = "updraft"
        , report_url = "https://uptake.github.io/pkgnet-gallery/exhibits/updraft/updraft.html"
        , image_url = "https://uptake.github.io/pkgnet-gallery/exhibits/updraft/updraft.png"
    )
    , list(
        package_name = "uptasticsearch"
        , report_url = "https://uptake.github.io/pkgnet-gallery/exhibits/uptasticsearch/uptasticsearch.html"
        , image_url = "https://uptake.github.io/pkgnet-gallery/exhibits/uptasticsearch/uptasticsearch.png"
    )
    
    ### ADD NEW EXHIBITS ABOVE THIS LINE ###
)

assertthat::assert_that(
    all(vapply(
        X = exhibitsList
        , FUN = is.list
        , FUN.VALUE = logical(1)
    ))
    , msg = "Not all elements of exhibitsList is a list."
)

assertthat::assert_that(
    all(vapply(
        X = exhibitsList
        , FUN = function(exh) {
            setequal(names(exh), c("package_name", "report_url", "image_url"))
        }
        , FUN.VALUE = logical(1)
    ))
    , msg = "Not all elements of exhibitsList have 'package_name', 'report_url', 'image_url'"
)

assertthat::assert_that(
    all(vapply(
        X = exhibitsList
        , FUN = function(exh) {
            all(vapply(
                X = exh
                , FUN = is.character
                , FUN.VALUE = logical(1)
            ))
        }
        , FUN.VALUE = logical(1)
    ))
    , msg = "Some exhibit(s) have non-character values for 'package_name', 'report_url', or 'image_url'"
)

# Sort exhibits alphabetically by name
exhibitsList <- exhibitsList[order(
    # Pull out package_name to use with order to reorder
    vapply(exhibitsList, `[[`, i = "package_name", FUN.VALUE = character(1))
)]
```

```{r write_html, include = FALSE}

# Template for one cell in exhibit table, for use with glue
cellTemplate <- '
<td width="33%" style="text-align:center">{package_name}<br>
    <a href="{report_url}">
        <img width="300" src="{image_url}">
    </a>
</td>
'

numRows <- ceiling(length(exhibitsList)/3)
cellToRowMapping <- ceiling(1:length(exhibitsList)/3)

# Generate vector of row html blobs
rowHTML <- vapply(
    X = 1:numRows
    , FUN = function(row) {
        paste('<tr>'
              # Paste together cells
              , paste(
                  # Generate cell HTML
                  vapply(
                    X = exhibitsList[cellToRowMapping == row]
                    , FUN = function(exh) {
                        glue::glue(
                            cellTemplate
                            , package_name = exh[['package_name']]
                            , report_url = exh[['report_url']]
                            , image_url = exh[['image_url']]
                        )
                    }
                    , FUN.VALUE = character(1)
                  )
                  , collapse = "\n"
              )
              , '</tr>'
              , sep = '\n'
        )
    }
    , FUN.VALUE = character(1)
)

tableHTML <- paste(
    '<table>'
    , paste(rowHTML, collapse = '\n')
    , '</table>'
    , sep = "\n"
)
```

```{r html_output, echo = FALSE}
knitr::asis_output(htmltools::htmlPreserve(tableHTML))
```