Hello,
I am creating a datatable and having a bit of trouble formatting it. There are two things that I would like to do. First, in the title of the table I would like the italicize only the term "p" and no other terms. I'd like to italicize the title of the "p" column as well. Second, I would like to replace all 0% terms with dashes, "-", when p is 0.00 or 1.00.
Thanks for your help!
library(tidyverse)
library(gt)
library(janitor)
#>
#> Attaching package: 'janitor'
#> The following objects are masked from 'package:stats':
#>
#> chisq.test, fisher.test
library(fs)
coin_flips <- tibble(replicate = 1:10000) %>%
mutate(Coin = sample(c("0.00", "0.25","0.50", "0.75", "1.00"),
size = 10000,
replace = TRUE,
prob = c(0.25, 0.05, 0.40, 0.05, 0.25))) %>%
mutate(
Flip1 = case_when(
Coin == "0.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.00, 1.00)),
Coin == "0.25" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.25, 0.75)),
Coin == "0.50" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.50, 0.50)),
Coin == "0.75" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.75, 0.25)),
Coin == "1.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(1.00, 0.00))
)
) %>%
mutate(
Flip2 = case_when(
Coin == "0.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.00, 1.00)),
Coin == "0.25" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.25, 0.75)),
Coin == "0.50" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.50, 0.50)),
Coin == "0.75" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.75, 0.25)),
Coin == "1.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(1.00, 0.00))
)
) %>%
mutate(
Flip3 = case_when(
Coin == "0.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.00, 1.00)),
Coin == "0.25" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.25, 0.75)),
Coin == "0.50" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.50, 0.50)),
Coin == "0.75" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.75, 0.25)),
Coin == "1.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(1.00, 0.00))
)
) %>%
mutate(
Flip4 = case_when(
Coin == "0.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.00, 1.00)),
Coin == "0.25" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.25, 0.75)),
Coin == "0.50" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.50, 0.50)),
Coin == "0.75" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.75, 0.25)),
Coin == "1.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(1.00, 0.00))
)
) %>%
mutate(
Flip5 = case_when(
Coin == "0.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.00, 1.00)),
Coin == "0.25" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.25, 0.75)),
Coin == "0.50" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.50, 0.50)),
Coin == "0.75" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.75, 0.25)),
Coin == "1.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(1.00, 0.00))
)
) %>%
mutate(
Flip6 = case_when(
Coin == "0.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.00, 1.00)),
Coin == "0.25" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.25, 0.75)),
Coin == "0.50" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.50, 0.50)),
Coin == "0.75" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(0.75, 0.25)),
Coin == "1.00" ~ sample(c(1, 0), size = 10000, replace = TRUE, prob = c(1.00, 0.00))
)
)
coin_flips %>%
mutate(heads = rowSums(coin_flips[,3:8])) %>%
tabyl(Coin, heads) %>%
adorn_percentages(denominator = "col") %>%
adorn_pct_formatting(digits = 0) %>%
gt() %>%
tab_header(
title = ("Posterior for p Based on Six Flips")
) %>%
tab_spanner(
label = "Number of Heads",
columns = vars(`0`, `1`, `2`, `3`, `4`, `5`, `6`)
) %>%
cols_label(
`Coin` = "p",
`0` = "Zero",
`1` = "One",
`2` = "Two",
`3` = "Three",
`4` = "Four",
`5` = "Five",
`6` = "Six"
)
html {
font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, Oxygen, Ubuntu, Cantarell, 'Helvetica Neue', 'Fira Sans', 'Droid Sans', Arial, sans-serif;
}
#xnsoqtfsig .gt_table {
display: table;
border-collapse: collapse;
margin-left: auto;
margin-right: auto;
color: #333333;
font-size: 16px;
background-color: #FFFFFF;
/* table.background.color */
width: auto;
/* table.width */
border-top-style: solid;
/* table.border.top.style */
border-top-width: 2px;
/* table.border.top.width */
border-top-color: #A8A8A8;
/* table.border.top.color */
border-bottom-style: solid;
/* table.border.bottom.style */
border-bottom-width: 2px;
/* table.border.bottom.width */
border-bottom-color: #A8A8A8;
/* table.border.bottom.color */
}
#xnsoqtfsig .gt_heading {
background-color: #FFFFFF;
/* heading.background.color */
border-bottom-color: #FFFFFF;
}
#xnsoqtfsig .gt_title {
color: #333333;
font-size: 125%;
/* heading.title.font.size */
padding-top: 4px;
/* heading.top.padding - not yet used */
padding-bottom: 4px;
border-bottom-color: #FFFFFF;
border-bottom-width: 0;
}
#xnsoqtfsig .gt_subtitle {
color: #333333;
font-size: 85%;
/* heading.subtitle.font.size */
padding-top: 0;
padding-bottom: 4px;
/* heading.bottom.padding - not yet used */
border-top-color: #FFFFFF;
border-top-width: 0;
}
#xnsoqtfsig .gt_bottom_border {
border-bottom-style: solid;
/* heading.border.bottom.style */
border-bottom-width: 2px;
/* heading.border.bottom.width */
border-bottom-color: #D3D3D3;
/* heading.border.bottom.color */
}
#xnsoqtfsig .gt_column_spanner {
border-bottom-style: solid;
border-bottom-width: 2px;
border-bottom-color: #D3D3D3;
padding-top: 4px;
padding-bottom: 4px;
}
#xnsoqtfsig .gt_col_heading {
color: #333333;
background-color: #FFFFFF;
/* column_labels.background.color */
font-size: 16px;
/* column_labels.font.size */
font-weight: initial;
/* column_labels.font.weight */
vertical-align: middle;
padding: 5px;
margin: 10px;
overflow-x: hidden;
}
#xnsoqtfsig .gt_columns_top_border {
border-top-style: solid;
border-top-width: 2px;
border-top-color: #D3D3D3;
}
#xnsoqtfsig .gt_columns_bottom_border {
border-bottom-style: solid;
border-bottom-width: 2px;
border-bottom-color: #D3D3D3;
}
#xnsoqtfsig .gt_sep_right {
border-right: 5px solid #FFFFFF;
}
#xnsoqtfsig .gt_group_heading {
padding: 8px;
/* row_group.padding */
color: #333333;
background-color: #FFFFFF;
/* row_group.background.color */
font-size: 16px;
/* row_group.font.size */
font-weight: initial;
/* row_group.font.weight */
border-top-style: solid;
/* row_group.border.top.style */
border-top-width: 2px;
/* row_group.border.top.width */
border-top-color: #D3D3D3;
/* row_group.border.top.color */
border-bottom-style: solid;
/* row_group.border.bottom.style */
border-bottom-width: 2px;
/* row_group.border.bottom.width */
border-bottom-color: #D3D3D3;
/* row_group.border.bottom.color */
vertical-align: middle;
}
#xnsoqtfsig .gt_empty_group_heading {
padding: 0.5px;
color: #333333;
background-color: #FFFFFF;
/* row_group.background.color */
font-size: 16px;
/* row_group.font.size */
font-weight: initial;
/* row_group.font.weight */
border-top-style: solid;
/* row_group.border.top.style */
border-top-width: 2px;
/* row_group.border.top.width */
border-top-color: #D3D3D3;
/* row_group.border.top.color */
border-bottom-style: solid;
/* row_group.border.bottom.style */
border-bottom-width: 2px;
/* row_group.border.bottom.width */
border-bottom-color: #D3D3D3;
/* row_group.border.bottom.color */
vertical-align: middle;
}
#xnsoqtfsig .gt_striped {
background-color: #8080800D;
}
#xnsoqtfsig .gt_from_md > :first-child {
margin-top: 0;
}
#xnsoqtfsig .gt_from_md > :last-child {
margin-bottom: 0;
}
#xnsoqtfsig .gt_row {
padding: 8px;
/* row.padding */
margin: 10px;
border-top-style: solid;
border-top-width: 1px;
border-top-color: #D3D3D3;
vertical-align: middle;
overflow-x: hidden;
}
#xnsoqtfsig .gt_stub {
border-right-style: solid;
border-right-width: 2px;
border-right-color: #D3D3D3;
padding-left: 12px;
}
#xnsoqtfsig .gt_summary_row {
color: #333333;
background-color: #FFFFFF;
/* summary_row.background.color */
padding: 8px;
/* summary_row.padding */
text-transform: inherit;
/* summary_row.text_transform */
}
#xnsoqtfsig .gt_grand_summary_row {
color: #333333;
background-color: #FFFFFF;
/* grand_summary_row.background.color */
padding: 8px;
/* grand_summary_row.padding */
text-transform: inherit;
/* grand_summary_row.text_transform */
}
#xnsoqtfsig .gt_first_summary_row {
border-top-style: solid;
border-top-width: 2px;
border-top-color: #D3D3D3;
}
#xnsoqtfsig .gt_first_grand_summary_row {
border-top-style: double;
border-top-width: 6px;
border-top-color: #D3D3D3;
}
#xnsoqtfsig .gt_table_body {
border-top-style: solid;
/* table_body.border.top.style */
border-top-width: 2px;
/* table_body.border.top.width */
border-top-color: #D3D3D3;
/* table_body.border.top.color */
border-bottom-style: solid;
/* table_body.border.bottom.style */
border-bottom-width: 2px;
/* table_body.border.bottom.width */
border-bottom-color: #D3D3D3;
/* table_body.border.bottom.color */
}
#xnsoqtfsig .gt_footnotes {
border-top-style: solid;
/* footnotes.border.top.style */
border-top-width: 2px;
/* footnotes.border.top.width */
border-top-color: #D3D3D3;
/* footnotes.border.top.color */
}
#xnsoqtfsig .gt_footnote {
font-size: 90%;
/* footnote.font.size */
margin: 0px;
padding: 4px;
/* footnote.padding */
}
#xnsoqtfsig .gt_sourcenotes {
border-top-style: solid;
/* sourcenotes.border.top.style */
border-top-width: 2px;
/* sourcenotes.border.top.width */
border-top-color: #D3D3D3;
/* sourcenotes.border.top.color */
}
#xnsoqtfsig .gt_sourcenote {
font-size: 90%;
/* sourcenote.font.size */
padding: 4px;
/* sourcenote.padding */
}
#xnsoqtfsig .gt_center {
text-align: center;
}
#xnsoqtfsig .gt_left {
text-align: left;
}
#xnsoqtfsig .gt_right {
text-align: right;
font-variant-numeric: tabular-nums;
}
#xnsoqtfsig .gt_font_normal {
font-weight: normal;
}
#xnsoqtfsig .gt_font_bold {
font-weight: bold;
}
#xnsoqtfsig .gt_font_italic {
font-style: italic;
}
#xnsoqtfsig .gt_super {
font-size: 65%;
}
#xnsoqtfsig .gt_footnote_marks {
font-style: italic;
font-size: 65%;
}
Posterior for p Based on Six Flips |
|||||||
---|---|---|---|---|---|---|---|
p |
Number of Heads |
||||||
Zero |
One |
Two |
Three |
Four |
Five |
Six |
|
0.00 |
94% |
0% |
0% |
0% |
0% |
0% |
0% |
0.25 |
4% |
31% |
14% |
5% |
1% |
1% |
0% |
0.50 |
3% |
68% |
85% |
90% |
85% |
68% |
3% |
0.75 |
0% |
0% |
1% |
5% |
14% |
32% |
4% |
1.00 |
0% |
0% |
0% |
0% |
0% |
0% |
93% |
Created on 2019-10-19 by the reprex package (v0.3.0)
^ The table as it appears in rStudio