data-dictionary-layout-v7.qmd

---
title: "Data Dictionary"
format:
  html:
    embed-resources: true
editor: visual
---

<br><br><br>

```{r, warning=F, message=F, include=F}
library( htmltools )
library( dplyr )
library( pointblank )
library( knitr )
library( gt )
library( kableExtra )
library( psych )
```

```{r}
#| echo: false

vname <- "VARNAME"

vlabel <- "Ipsum is simply dummy text of the printing and typesetting industry."

vtype <- "numeric"

vscope <- "PZ"

flevels <- 
structure(list(FLEVEL = c("AL", "AK", "AZ", "AR", "CA", "CO"
), LABEL = c("Alabama", "Alaska", "Arizona", "Arkansas", 
"California", "Colorado")), row.names = c(NA, 6L), class = "data.frame")

desc <- "Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book."

loc <- "SCHED-A-PART-01-LINE-01"

to_table <- function( f, format="html" )
{
  t <- table( f )
  t2 <- as.data.frame(t)
  names(t2) <- c("Level","Label")
  t2 %>% kable( format )
}

dgf <- data.frame( desc, loc )

k <- kable( flevels )

quant <- 
structure(list(q1 = c("Q-05", "Q-25", "Q-50", "Q-75", "Q-95"), 
    q2 = c(0, 100, 500, 900, 1234)), class = "data.frame", row.names = c(NA, 
-5L))

stats <- 
structure(list(s1 = c("Min", "Median", "Mean", "Max", "Skew", 
"Kurtosis"), s2 = c("x", "x", "x", "x", "x", "x")), class = "data.frame", row.names = c(NA, 
-6L))

q <- kable( quant )

s <- kable( stats )

# Example values
vals <- round( rnorm(25,100000,100000), 0 )

# convert to table
e <- gt( as.data.frame( matrix( vals, nrow=5 ) ) )

e <- tab_options( e, column_labels.hidden = T )

e <- data_color( e,
                   palette=scales::col_numeric( c( "white", "aquamarine3" ),
                                                domain=NULL ) )

to_txt_string <- function( x, x.lab=NULL )
{
  txt <- paste0( "**", x.lab, "**", ": ",  x, "\n\n" )
  cat( txt )
}

to_txt_factor <- function( x, x.lab=NULL )
{
  cat( paste0( "##### ", x.lab, "\n\n" ) )
  cat( paste0( x, " \n" ), sep="" )
  cat( "\n\n" )
}

v_to_txt <- function( v, v.lab )
{
  if( class(v) == "character" )
  { to_txt_string( x=v, x.lab=v.lab ) }
  if( class(v) == "knitr_kable" )
  { to_txt_factor( x=v, x.lab=v.lab ) }
}

x <- rnorm( 1000 )

build_proptable_numeric <- function( x, x.lab=NULL )
{
  dist <- length( unique( x ) )
  dist.p <- dist/length( x )
  miss <- sum( is.na( x ) )
  miss.p <- miss/length( x )
  prop.value <- c( dist, dist.p, miss, miss.p )
  prop.labels <- c( "Distinct (n)", "Distinct (%)", "Missing (n)", "Missing (%)" )
  properties <- data.frame( prop.labels, prop.value )
  cat( paste0( "##### ", x.lab, "\n\n" ) )
  cat( paste0( kable( properties ), " \n" ), sep="" )
  cat( "\n\n" )
}

build_quanttable_numeric <- function( x, x.lab=NULL )
{
  quant.value <- quantile( x, c( 0.05, 0.25, 0.50, 0.75, 0.95 ) )
  quant.labels <- c( "Q-05", "Q-25", "Q-50", "Q-75", "Q-95" )
  quant <- data.frame( quant.labels, quant.value )
  cat( paste0( "##### ", x.lab, "\n\n" ) )
  cat( paste0( remove_column( kable( quant ), 1 ), " \n" ), sep="" )
  cat( "\n\n" )
}

build_stattable_numeric <- function( x, x.lab=NULL )
{
  min <- min( x, na.rm=T )
  median <- median( x, na.rm=T )
  mean <- mean( x, na.rm=T )
  max <- max( x, na.rm=T )
  skew <- skew( x, na.rm=T )
  kurt <- kurtosi( x, na.rm=T )
  stat.value <- c( min, median, mean, max, skew, kurt)
  stat.labels <- c( "Min", "Median", "Mean", "Max", "Skew", "Kurt" )
  stat <- data.frame( stat.labels, stat.value )
  cat( paste0( "##### ", x.lab, "\n\n" ) )
  cat( paste0( kable( stat ), " \n" ), sep="" )
  cat( "\n\n" )
}

create_div1 <- function( x1=vname )
{
  cat( "::: {.div1} \n\n" )
  cat( paste0( "#### ", x1, "\n\n" ) )
  cat( "::: \n\n" )
}

create_div1( x1=vname )

create_div2 <- function( x2=vlabel, x2.lab="LABEL" )
{
  cat( "::: {.div2} \n\n" )
  v_to_txt( x2, x2.lab )
  cat( "::: \n\n" )
}

create_div2( x2=vlabel )

create_div3 <- function( x3=vtype, x3.lab="DATA TYPE", 
                         x4=vscope, x4.lab="SCOPE" )
{
  cat( "::: {.div3} \n\n" )
  v_to_txt( x3, x3.lab )
  v_to_txt( x4, x4.lab )
  cat( "::: \n\n" )
}

create_div3( x3=vtype, x4=vscope )

create_div4 <- function( x5=desc, x5.lab="DESCRIPTION", 
                         x6=k, x6.lab="LEVELS", 
                         x7=loc, x7.lab="LOCATION CODE" )
{
  cat( "::: {.div4} \n\n" )
  v_to_txt( x5, x5.lab )
  v_to_txt( x6, x6.lab )
  v_to_txt( x7, x7.lab )
  cat( "::: \n\n" )
}

create_div4( x5=desc, x6=k, x7=loc )

create_div5 <- function( x8=x, x8.lab="Properties" )
{
  cat( "::: {.div5} \n\n" )
  build_proptable_numeric( x8, x8.lab )
  cat( "::: \n\n" )
}

create_div5( x8=x )

create_div6 <- function( x9=x, x9.lab="Quantiles" )
{
  cat( "::: {.div6} \n\n" )
  build_quanttable_numeric( x9, x9.lab )
  cat( "::: \n\n" )
}

create_div6( x9=x )

create_div7 <- function( x10=x, x10.lab="Statistics" )
{
  cat( "::: {.div7} \n\n" )
    build_stattable_numeric( x10, x10.lab )
  cat( "::: \n\n" )
}

create_div7( x10=x )

create_div8 <- function( x11.lab="Histogram" )
{
  cat( "::: {.div8} \n\n" )
  cat( paste0( "##### ", x11.lab, "\n\n" ) )
  barplot(table(cut(rnorm(1000),10)),col="steelblue")
  cat( "\n::: \n\n" )
}

create_div8( x11.lab="Histogram" )

create_div9 <- function( x12=e, x12.lab="Example values" )
{
  cat( "::: {.div9} \n\n" )
  cat( paste0( "##### ", x12.lab, "\n\n" ) )
  cat( as_raw_html( x12 ) )
  cat( "::: \n\n" )
}

create_div9( x12=e )

create_section <- function( x1=vname,
                            x2=vlabel, x2.lab="LABEL",
                            x3=vtype, x3.lab="DATA TYPE", 
                            x4=vscope, x4.lab="SCOPE",
                            x5=desc, x5.lab="DESCRIPTION", 
                            x6=k, x6.lab="LEVELS", 
                            x7=loc, x7.lab="LOCATION CODE",
                            x8=x, x8.lab="Properties",
                            x9=x, x9.lab="Quantiles",
                            x10=x, x10.lab="Statistics",
                            x11.lab="Histogram",
                            x12=e, x12.lab="Example values")
{
    cat( "{{< pagebreak >}} \n\n")  # add page break between variables?
    cat( "::::: {.parent} \n\n" )
    create_div1( x1=vname )
    create_div2( x2=vlabel )
    create_div3( x3=vtype, x4=vscope )
    create_div4( x5=desc, x6=k, x7=loc )
    create_div5( x8=x )
    create_div6( x9=x )
    create_div7( x10=x )
    create_div8( )
    create_div9( x12=e )
    cat( "::::: \n\n" )
}

```

<br>

<hr>

<br>

```{r, results="asis"}
# results="asis"
create_section( x1=vname, x2=vlabel, x3=vtype, x4=vscope, x5=desc, x6=k, x7=loc, x8=x, x9=x, x10=x, x12=e )
```

<br>

<hr>

<br>

```{r}
create_section2 <- function( x1=vname,
                            x2=vlabel, x2.lab="LABEL",
                            x3=vtype, x3.lab="DATA TYPE", 
                            x4=vscope, x4.lab="SCOPE",
                            x5=desc, x5.lab="DESCRIPTION", 
                            x6=k, x6.lab="LEVELS", 
                            x7=loc, x7.lab="LOCATION CODE",
                            x8=p, x8.lab="Properties",
                            x9=q, x9.lab="Quantiles",
                            x10=s, x10.lab="Statistics",
                            x11=t3k, x11.lab="Example values")
{
    cat( "{{< pagebreak >}} \n\n")  # add page break between variables?
    cat( "::::: {.parent} \n\n" )
    create_div1( x1=vname )
    # create_div2( x2=vlabel )
    create_div3( x3=vtype, x4=vscope )
    create_div4( x5=desc, x6=k, x7=loc )
    create_div5( x8=p )
    # create_div6( x9=q )
    create_div7( x10=s )
    create_div8( )
    # create_div9( x11=t3k )
    cat( ":::::" )
}
```

```{r, results="asis"}
# results="asis"
create_section( x1=vname, x2=vlabel, x3=vtype, x4=vscope, x5=desc, x6=k, x7=loc, x8=p, x9=q, x10=s, x12=e )
```

<br>

<hr>

<br>

```{r, eval=F}
#| echo: false

get_section <- function( row.name )
{
  ds <- dplyr::filter( dfg, var_name== row.name )
  create_section( x1=ds$desc, x2=ds$k, x3=ds$loc )
}

print_dd <- function( dfg, vars=c("r2","r2","r3"), group.name=NULL )
{
   # for( i in vars )
   # {
   #   get_section( row.name=i )
   # }
   dfg2 <- dplyr::filter( dfg, var_name %in% vars )
   sapply( dfg2, get_section )
}
```

```{r, eval=F}
#| echo: false

print_dd( dfg, vars( %in% partiii ), group.name="Part III" )

print_dd( dfg, vars( %in% partiv ), group.name="Part IV" )
```

```{=html}
<style>

@import url('https://fonts.cdnfonts.com/css/aharoni');

.parent {
    display: grid;
    grid-template-columns: repeat(3, 1fr);
    grid-template-rows: auto;  /* repeat(2, 0.2fr) 1fr 1fr 1fr; */
    grid-column-gap: 20px;
    grid-row-gap: 10px;
    grid-template-areas:
      "a a a"
      "b b b"
      "c d d"
      "e f g" 
      "h i i";
}



.div1 { grid-area: a; }

.div2 { 
    grid-area: b;
    padding-left: 50px;
}

.div3 { 
    grid-area: c;
    padding-left: 50px;
}

.div4 { 
    grid-area: d;
    padding-left: 20px;
}

.div5 { 
    grid-area: e;
    padding-left: 50px;
}

.div6 { 
    grid-area: f;
    padding-left: 50px;
}

.div7 { 
    grid-area: g;
    padding-left: 50px;
}

.div8 { 
    grid-area: h;
    padding-left: 50px;
    display: grid;
}

.div8 .cell-output-display { 
    display: grid;
}

.div8 p { 
    display: grid;
}


.div9 { 
    grid-area: i;
    padding-left: 20px;
}

h1.title { color: lightgray; }
h2.anchored { color: lightgray; }
h3.anchored { color: gray; }

h4 {
    text-decoration: underline;
    text-underline-offset: 10px;
    text-decoration-thickness: 2px;
    font-family: Georgia, Times, "Times New Roman", serif; 
    /* font-family: 'Fira Code'; */
    /* font-family: 'Aharoni', sans-serif; */
    font-size: 1.8em;
    font-weight: 700;  
    /* line-height: 120px; */ 
}

h5 { font-size: 0.9em; }

.div2 p { 
    font-family: Verdana;
    font-size: 1.1em;
}

.div3 td { 
    /* font-family: "Anonymous Pro"; */
    /* font-family: Georgia, Times, "Times New Roman", serif; */ 
    /* font-weight: 400; */
    font-family: 'Aharoni', sans-serif;
    font-size: 0.9em;
}

.div4 p { 
    font-family:"Calibri", sans-serif;
    font-size: 0.8em;
}

.div4 td { 
    font-family: "Anonymous Pro";
    /* font-weight: 400; */
    font-size: 0.9em;
}

.div4 table {
    margin-left: 20px;
}

.div5 td { 
    font-family: "Anonymous Pro";
    /* font-weight: 400; */
    font-size: 0.9em;
}

.div5 table {
    margin-left: 20px;
}

.div6 td { 
    font-family: "Anonymous Pro";
    /* font-weight: 400; */
    font-size: 0.9em;
}

.div6 table {
    margin-left: 20px;
}

.div7 td { 
    font-family: "Anonymous Pro";
    /* font-weight: 400; */
    font-size: 0.9em;
}

.div7 table {
    margin-left: 20px;
}

.table {
    width: 80%;
}

.table>tbody {
    border-top: none;
}

.table>:not(caption)>*>* {
    padding: 0rem 0rem;
}

tbody, tfoot, tr, td, th {
    border-color: inherit;
    border-style: none; 
    border-width: 0;
}


.div5 tr {
  border-bottom: 1px solid;
  border-color: #D3D3D3;
}

.div5 th {
  display:none;
}

.div6 tr {
  border-bottom: 1px solid;
  border-color: #D3D3D3;
}

.div6 th {
  display:none;
}

.div7 tr {
  border-bottom: 1px solid;
  border-color: #D3D3D3;
}

.div7 th {
  display:none;
}

.div8 img, svg {
    /* vertical-align: bottom;*/
    align-self: end;
    justify-self: end;
}

#pb_agent .gt_table {
    border-top-width: 0px; 
    /* border-top-color: #A8A8A8; */
}  

#pb_agent .gt_title {
    font-size: 1.3em !important;
}

#pb_agent .gt_left { color: black !important; }


@media print {
   body {
   display:table;
   table-layout:fixed;
   padding-top:2.5cm;
   padding-bottom:3cm;
   padding-left:1.5cm;
   padding-right:1.5cm;
   height:auto;
    }
}


</style>
```