From f10767a681ca4ad4f07d6f877e048428250ada4a Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sat, 16 Nov 2024 08:12:45 -0500 Subject: [PATCH 1/5] snapshots --- .../datasummary_balance-escape_FALSE.txt | 94 ++++++++++++++-- .../datasummary_balance-escape_TRUE.txt | 94 ++++++++++++++-- .../datasummary_balance-issue711.txt | 101 +++++++++++++++--- .../_tinysnapshot/escape-caption_notes.txt | 6 +- .../escape-correlation_latex.txt | 14 +-- .../escape-correlation_latex_FALSE.txt | 14 +-- .../_tinysnapshot/escape-crosstab_latex.txt | 8 +- .../escape-crosstab_latex_FALSE.txt | 8 +- .../escape-datasummary_escape_colnames.txt | 5 +- ...cape-datasummary_escape_colnames_FALSE.txt | 5 +- .../tinytest/_tinysnapshot/escape-escape.html | 95 +++++++--------- .../escape-escape_html_false.html | 95 +++++++--------- .../_tinysnapshot/escape-hat_I_formula.txt | 6 +- .../_tinysnapshot/escape-hat_fixest.txt | 6 +- .../_tinysnapshot/escape-issue707_01.txt | 4 +- .../_tinysnapshot/escape-issue707_02.txt | 5 +- .../_tinysnapshot/escape-issue707_03.txt | 4 +- .../_tinysnapshot/escape-issue707_04.txt | 5 +- inst/tinytest/_tinysnapshot/escape-latex.txt | 7 +- .../_tinysnapshot/escape-modelsummary.html | 95 +++++++--------- .../escape-modelsummary_latex.txt | 8 +- .../escape-modelsummary_latex2.txt | 8 +- .../tinytest/_tinysnapshot/html-gof_omit.html | 51 ++++++--- 23 files changed, 446 insertions(+), 292 deletions(-) diff --git a/inst/tinytest/_tinysnapshot/datasummary_balance-escape_FALSE.txt b/inst/tinytest/_tinysnapshot/datasummary_balance-escape_FALSE.txt index 05ba1ec7e..239af0482 100644 --- a/inst/tinytest/_tinysnapshot/datasummary_balance-escape_FALSE.txt +++ b/inst/tinytest/_tinysnapshot/datasummary_balance-escape_FALSE.txt @@ -4,16 +4,90 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]Q[]Q[]Q[]}, -cell{1}{2}={c=2,}{halign=c,}, -cell{1}{4}={c=2,}{halign=c,}, -column{1}={halign=l,}, -column{2}={halign=r,}, -column{3}={halign=r,}, -column{4}={halign=r,}, -column{5}={halign=r,}, -column{6}={halign=r,}, -column{7}={halign=r,}, -row{1}={halign=c,}, +cell{2}{1}={}{halign=l,}, +cell{3}{1}={}{halign=l,}, +cell{4}{1}={}{halign=l,}, +cell{5}{1}={}{halign=l,}, +cell{6}{1}={}{halign=l,}, +cell{7}{1}={}{halign=l,}, +cell{8}{1}={}{halign=l,}, +cell{9}{1}={}{halign=l,}, +cell{10}{1}={}{halign=l,}, +cell{11}{1}={}{halign=l,}, +cell{12}{1}={}{halign=l,}, +cell{1}{1}={}{halign=l, halign=c,}, +cell{2}{2}={}{halign=r,}, +cell{2}{3}={}{halign=r,}, +cell{2}{4}={}{halign=r,}, +cell{2}{5}={}{halign=r,}, +cell{2}{6}={}{halign=r,}, +cell{2}{7}={}{halign=r,}, +cell{3}{2}={}{halign=r,}, +cell{3}{3}={}{halign=r,}, +cell{3}{4}={}{halign=r,}, +cell{3}{5}={}{halign=r,}, +cell{3}{6}={}{halign=r,}, +cell{3}{7}={}{halign=r,}, +cell{4}{2}={}{halign=r,}, +cell{4}{3}={}{halign=r,}, +cell{4}{4}={}{halign=r,}, +cell{4}{5}={}{halign=r,}, +cell{4}{6}={}{halign=r,}, +cell{4}{7}={}{halign=r,}, +cell{5}{2}={}{halign=r,}, +cell{5}{3}={}{halign=r,}, +cell{5}{4}={}{halign=r,}, +cell{5}{5}={}{halign=r,}, +cell{5}{6}={}{halign=r,}, +cell{5}{7}={}{halign=r,}, +cell{6}{2}={}{halign=r,}, +cell{6}{3}={}{halign=r,}, +cell{6}{4}={}{halign=r,}, +cell{6}{5}={}{halign=r,}, +cell{6}{6}={}{halign=r,}, +cell{6}{7}={}{halign=r,}, +cell{7}{2}={}{halign=r,}, +cell{7}{3}={}{halign=r,}, +cell{7}{4}={}{halign=r,}, +cell{7}{5}={}{halign=r,}, +cell{7}{6}={}{halign=r,}, +cell{7}{7}={}{halign=r,}, +cell{8}{2}={}{halign=r,}, +cell{8}{3}={}{halign=r,}, +cell{8}{4}={}{halign=r,}, +cell{8}{5}={}{halign=r,}, +cell{8}{6}={}{halign=r,}, +cell{8}{7}={}{halign=r,}, +cell{9}{2}={}{halign=r,}, +cell{9}{3}={}{halign=r,}, +cell{9}{4}={}{halign=r,}, +cell{9}{5}={}{halign=r,}, +cell{9}{6}={}{halign=r,}, +cell{9}{7}={}{halign=r,}, +cell{10}{2}={}{halign=r,}, +cell{10}{3}={}{halign=r,}, +cell{10}{4}={}{halign=r,}, +cell{10}{5}={}{halign=r,}, +cell{10}{6}={}{halign=r,}, +cell{10}{7}={}{halign=r,}, +cell{11}{2}={}{halign=r,}, +cell{11}{3}={}{halign=r,}, +cell{11}{4}={}{halign=r,}, +cell{11}{5}={}{halign=r,}, +cell{11}{6}={}{halign=r,}, +cell{11}{7}={}{halign=r,}, +cell{12}{2}={}{halign=r,}, +cell{12}{3}={}{halign=r,}, +cell{12}{4}={}{halign=r,}, +cell{12}{5}={}{halign=r,}, +cell{12}{6}={}{halign=r,}, +cell{12}{7}={}{halign=r,}, +cell{1}{3}={}{halign=r, halign=c,}, +cell{1}{5}={}{halign=r, halign=c,}, +cell{1}{6}={}{halign=r, halign=c,}, +cell{1}{7}={}{halign=r, halign=c,}, +cell{1}{2}={c=2,}{halign=r, halign=c, halign=c,}, +cell{1}{4}={c=2,}{halign=r, halign=c, halign=c,}, } %% tabularray inner close \toprule & no_no (N=18) & & yes_yes (N=14) & & & \\ \cmidrule[lr]{2-3}\cmidrule[lr]{4-5} diff --git a/inst/tinytest/_tinysnapshot/datasummary_balance-escape_TRUE.txt b/inst/tinytest/_tinysnapshot/datasummary_balance-escape_TRUE.txt index 358eae518..e10c4ca55 100644 --- a/inst/tinytest/_tinysnapshot/datasummary_balance-escape_TRUE.txt +++ b/inst/tinytest/_tinysnapshot/datasummary_balance-escape_TRUE.txt @@ -4,16 +4,90 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]Q[]Q[]Q[]}, -cell{1}{2}={c=2,}{halign=c,}, -cell{1}{4}={c=2,}{halign=c,}, -column{1}={halign=l,}, -column{2}={halign=r,}, -column{3}={halign=r,}, -column{4}={halign=r,}, -column{5}={halign=r,}, -column{6}={halign=r,}, -column{7}={halign=r,}, -row{1}={halign=c,}, +cell{2}{1}={}{halign=l,}, +cell{3}{1}={}{halign=l,}, +cell{4}{1}={}{halign=l,}, +cell{5}{1}={}{halign=l,}, +cell{6}{1}={}{halign=l,}, +cell{7}{1}={}{halign=l,}, +cell{8}{1}={}{halign=l,}, +cell{9}{1}={}{halign=l,}, +cell{10}{1}={}{halign=l,}, +cell{11}{1}={}{halign=l,}, +cell{12}{1}={}{halign=l,}, +cell{1}{1}={}{halign=l, halign=c,}, +cell{2}{2}={}{halign=r,}, +cell{2}{3}={}{halign=r,}, +cell{2}{4}={}{halign=r,}, +cell{2}{5}={}{halign=r,}, +cell{2}{6}={}{halign=r,}, +cell{2}{7}={}{halign=r,}, +cell{3}{2}={}{halign=r,}, +cell{3}{3}={}{halign=r,}, +cell{3}{4}={}{halign=r,}, +cell{3}{5}={}{halign=r,}, +cell{3}{6}={}{halign=r,}, +cell{3}{7}={}{halign=r,}, +cell{4}{2}={}{halign=r,}, +cell{4}{3}={}{halign=r,}, +cell{4}{4}={}{halign=r,}, +cell{4}{5}={}{halign=r,}, +cell{4}{6}={}{halign=r,}, +cell{4}{7}={}{halign=r,}, +cell{5}{2}={}{halign=r,}, +cell{5}{3}={}{halign=r,}, +cell{5}{4}={}{halign=r,}, +cell{5}{5}={}{halign=r,}, +cell{5}{6}={}{halign=r,}, +cell{5}{7}={}{halign=r,}, +cell{6}{2}={}{halign=r,}, +cell{6}{3}={}{halign=r,}, +cell{6}{4}={}{halign=r,}, +cell{6}{5}={}{halign=r,}, +cell{6}{6}={}{halign=r,}, +cell{6}{7}={}{halign=r,}, +cell{7}{2}={}{halign=r,}, +cell{7}{3}={}{halign=r,}, +cell{7}{4}={}{halign=r,}, +cell{7}{5}={}{halign=r,}, +cell{7}{6}={}{halign=r,}, +cell{7}{7}={}{halign=r,}, +cell{8}{2}={}{halign=r,}, +cell{8}{3}={}{halign=r,}, +cell{8}{4}={}{halign=r,}, +cell{8}{5}={}{halign=r,}, +cell{8}{6}={}{halign=r,}, +cell{8}{7}={}{halign=r,}, +cell{9}{2}={}{halign=r,}, +cell{9}{3}={}{halign=r,}, +cell{9}{4}={}{halign=r,}, +cell{9}{5}={}{halign=r,}, +cell{9}{6}={}{halign=r,}, +cell{9}{7}={}{halign=r,}, +cell{10}{2}={}{halign=r,}, +cell{10}{3}={}{halign=r,}, +cell{10}{4}={}{halign=r,}, +cell{10}{5}={}{halign=r,}, +cell{10}{6}={}{halign=r,}, +cell{10}{7}={}{halign=r,}, +cell{11}{2}={}{halign=r,}, +cell{11}{3}={}{halign=r,}, +cell{11}{4}={}{halign=r,}, +cell{11}{5}={}{halign=r,}, +cell{11}{6}={}{halign=r,}, +cell{11}{7}={}{halign=r,}, +cell{12}{2}={}{halign=r,}, +cell{12}{3}={}{halign=r,}, +cell{12}{4}={}{halign=r,}, +cell{12}{5}={}{halign=r,}, +cell{12}{6}={}{halign=r,}, +cell{12}{7}={}{halign=r,}, +cell{1}{3}={}{halign=r, halign=c,}, +cell{1}{5}={}{halign=r, halign=c,}, +cell{1}{6}={}{halign=r, halign=c,}, +cell{1}{7}={}{halign=r, halign=c,}, +cell{1}{2}={c=2,}{halign=r, halign=c, halign=c,}, +cell{1}{4}={c=2,}{halign=r, halign=c, halign=c,}, } %% tabularray inner close \toprule & no\_no (N=18) & & yes\_yes (N=14) & & & \\ \cmidrule[lr]{2-3}\cmidrule[lr]{4-5} diff --git a/inst/tinytest/_tinysnapshot/datasummary_balance-issue711.txt b/inst/tinytest/_tinysnapshot/datasummary_balance-issue711.txt index 3fbaee6bb..1090ac930 100644 --- a/inst/tinytest/_tinysnapshot/datasummary_balance-issue711.txt +++ b/inst/tinytest/_tinysnapshot/datasummary_balance-issue711.txt @@ -4,20 +4,95 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]}, -cell{1}{3}={c=2,}{halign=c,}, -cell{1}{5}={c=2,}{halign=c,}, -column{1}={halign=l,}, -column{2}={halign=l,}, -column{3}={halign=l,}, -column{4}={halign=l,}, -column{5}={halign=l,}, -column{6}={halign=l,}, column{7}={si={table-format=-2.3,table-align-text-before=false,table-align-text-after=false,input-symbols={-,\*+()}},}, -row{1}={guard}, -row{2}={guard}, -column{8}={halign=l,}, -row{1}={halign=c,}, -hline{7}={1,2,3,4,5,6,7,8}{solid, 0.05em, black}, +cell{1}{7}={guard,halign=c,}, +cell{2}{7}={guard,halign=c,}, +cell{1}{7}={}{halign=c,}, +cell{2}{1}={}{halign=l,}, +cell{2}{2}={}{halign=l,}, +cell{2}{3}={}{halign=l,}, +cell{2}{4}={}{halign=l,}, +cell{2}{5}={}{halign=l,}, +cell{2}{6}={}{halign=l,}, +cell{2}{8}={}{halign=l,}, +cell{3}{1}={}{halign=l,}, +cell{3}{2}={}{halign=l,}, +cell{3}{3}={}{halign=l,}, +cell{3}{4}={}{halign=l,}, +cell{3}{5}={}{halign=l,}, +cell{3}{6}={}{halign=l,}, +cell{3}{8}={}{halign=l,}, +cell{4}{1}={}{halign=l,}, +cell{4}{2}={}{halign=l,}, +cell{4}{3}={}{halign=l,}, +cell{4}{4}={}{halign=l,}, +cell{4}{5}={}{halign=l,}, +cell{4}{6}={}{halign=l,}, +cell{4}{8}={}{halign=l,}, +cell{5}{1}={}{halign=l,}, +cell{5}{2}={}{halign=l,}, +cell{5}{3}={}{halign=l,}, +cell{5}{4}={}{halign=l,}, +cell{5}{5}={}{halign=l,}, +cell{5}{6}={}{halign=l,}, +cell{5}{8}={}{halign=l,}, +cell{6}{1}={}{halign=l,}, +cell{6}{2}={}{halign=l,}, +cell{6}{3}={}{halign=l,}, +cell{6}{4}={}{halign=l,}, +cell{6}{5}={}{halign=l,}, +cell{6}{6}={}{halign=l,}, +cell{6}{8}={}{halign=l,}, +cell{7}{1}={}{halign=l,}, +cell{7}{2}={}{halign=l,}, +cell{7}{3}={}{halign=l,}, +cell{7}{4}={}{halign=l,}, +cell{7}{5}={}{halign=l,}, +cell{7}{6}={}{halign=l,}, +cell{7}{8}={}{halign=l,}, +cell{8}{1}={}{halign=l,}, +cell{8}{2}={}{halign=l,}, +cell{8}{3}={}{halign=l,}, +cell{8}{4}={}{halign=l,}, +cell{8}{5}={}{halign=l,}, +cell{8}{6}={}{halign=l,}, +cell{8}{8}={}{halign=l,}, +cell{9}{1}={}{halign=l,}, +cell{9}{2}={}{halign=l,}, +cell{9}{3}={}{halign=l,}, +cell{9}{4}={}{halign=l,}, +cell{9}{5}={}{halign=l,}, +cell{9}{6}={}{halign=l,}, +cell{9}{8}={}{halign=l,}, +cell{10}{1}={}{halign=l,}, +cell{10}{2}={}{halign=l,}, +cell{10}{3}={}{halign=l,}, +cell{10}{4}={}{halign=l,}, +cell{10}{5}={}{halign=l,}, +cell{10}{6}={}{halign=l,}, +cell{10}{8}={}{halign=l,}, +cell{11}{1}={}{halign=l,}, +cell{11}{2}={}{halign=l,}, +cell{11}{3}={}{halign=l,}, +cell{11}{4}={}{halign=l,}, +cell{11}{5}={}{halign=l,}, +cell{11}{6}={}{halign=l,}, +cell{11}{8}={}{halign=l,}, +cell{12}{1}={}{halign=l,}, +cell{12}{2}={}{halign=l,}, +cell{12}{3}={}{halign=l,}, +cell{12}{4}={}{halign=l,}, +cell{12}{5}={}{halign=l,}, +cell{12}{6}={}{halign=l,}, +cell{12}{8}={}{halign=l,}, +cell{1}{1}={}{halign=l, halign=c,}, +cell{1}{2}={}{halign=l, halign=c,}, +cell{1}{4}={}{halign=l, halign=c,}, +cell{1}{6}={}{halign=l, halign=c,}, +cell{1}{8}={}{halign=l, halign=c,}, +cell{1}{3}={c=2,}{halign=l, halign=c, halign=c,}, +cell{1}{5}={c=2,}{halign=l, halign=c, halign=c,}, +hline{7}={1,2,3,4,5,6,7,8}{solid, black, 0.05em}, } %% tabularray inner close \toprule & & Control (N=2490) & & Treatment (N=185) & & & \\ \cmidrule[lr]{3-4}\cmidrule[lr]{5-6} diff --git a/inst/tinytest/_tinysnapshot/escape-caption_notes.txt b/inst/tinytest/_tinysnapshot/escape-caption_notes.txt index db887fc83..68d00286e 100644 --- a/inst/tinytest/_tinysnapshot/escape-caption_notes.txt +++ b/inst/tinytest/_tinysnapshot/escape-caption_notes.txt @@ -7,9 +7,9 @@ note{ }={hello\_world}, ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -hline{10}={1,2}{solid, 0.05em, black}, +column{2}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{10}={1,2}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-correlation_latex.txt b/inst/tinytest/_tinysnapshot/escape-correlation_latex.txt index 0045fa1a2..346d38d46 100644 --- a/inst/tinytest/_tinysnapshot/escape-correlation_latex.txt +++ b/inst/tinytest/_tinysnapshot/escape-correlation_latex.txt @@ -4,18 +4,8 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=r,}, -column{3}={halign=r,}, -column{4}={halign=r,}, -column{5}={halign=r,}, -column{6}={halign=r,}, -column{7}={halign=r,}, -column{8}={halign=r,}, -column{9}={halign=r,}, -column{10}={halign=r,}, -column{11}={halign=r,}, -column{12}={halign=r,}, +column{1}={}{halign=l,}, +column{2,3,4,5,6,7,8,9,10,11,12}={}{halign=r,}, } %% tabularray inner close \toprule & under\_score & oh\&yeah2 & disp & hp & drat & wt & qsec & vs & am & gear & carb \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-correlation_latex_FALSE.txt b/inst/tinytest/_tinysnapshot/escape-correlation_latex_FALSE.txt index 84b18be81..8ccfb2c30 100644 --- a/inst/tinytest/_tinysnapshot/escape-correlation_latex_FALSE.txt +++ b/inst/tinytest/_tinysnapshot/escape-correlation_latex_FALSE.txt @@ -4,18 +4,8 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=r,}, -column{3}={halign=r,}, -column{4}={halign=r,}, -column{5}={halign=r,}, -column{6}={halign=r,}, -column{7}={halign=r,}, -column{8}={halign=r,}, -column{9}={halign=r,}, -column{10}={halign=r,}, -column{11}={halign=r,}, -column{12}={halign=r,}, +column{1}={}{halign=l,}, +column{2,3,4,5,6,7,8,9,10,11,12}={}{halign=r,}, } %% tabularray inner close \toprule & under_score & oh&yeah2 & disp & hp & drat & wt & qsec & vs & am & gear & carb \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-crosstab_latex.txt b/inst/tinytest/_tinysnapshot/escape-crosstab_latex.txt index 2fb2af576..d0ee01212 100644 --- a/inst/tinytest/_tinysnapshot/escape-crosstab_latex.txt +++ b/inst/tinytest/_tinysnapshot/escape-crosstab_latex.txt @@ -4,12 +4,8 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=l,}, -column{3}={halign=l,}, -column{4}={halign=r,}, -column{5}={halign=r,}, -column{6}={halign=r,}, +column{1,2,3}={}{halign=l,}, +column{4,5,6}={}{halign=r,}, } %% tabularray inner close \toprule under\_score1 & under\_score2 & & 0 & 1 & All \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-crosstab_latex_FALSE.txt b/inst/tinytest/_tinysnapshot/escape-crosstab_latex_FALSE.txt index f15c88fd2..b4552b5d0 100644 --- a/inst/tinytest/_tinysnapshot/escape-crosstab_latex_FALSE.txt +++ b/inst/tinytest/_tinysnapshot/escape-crosstab_latex_FALSE.txt @@ -4,12 +4,8 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=l,}, -column{3}={halign=l,}, -column{4}={halign=r,}, -column{5}={halign=r,}, -column{6}={halign=r,}, +column{1,2,3}={}{halign=l,}, +column{4,5,6}={}{halign=r,}, } %% tabularray inner close \toprule under_score1 & under_score2 & & 0 & 1 & All \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-datasummary_escape_colnames.txt b/inst/tinytest/_tinysnapshot/escape-datasummary_escape_colnames.txt index 28b489b19..502a0ac72 100644 --- a/inst/tinytest/_tinysnapshot/escape-datasummary_escape_colnames.txt +++ b/inst/tinytest/_tinysnapshot/escape-datasummary_escape_colnames.txt @@ -4,9 +4,8 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=r,}, -column{3}={halign=r,}, +column{1}={}{halign=l,}, +column{2,3}={}{halign=r,}, } %% tabularray inner close \toprule & \% & Money \$\$ \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-datasummary_escape_colnames_FALSE.txt b/inst/tinytest/_tinysnapshot/escape-datasummary_escape_colnames_FALSE.txt index 18c553675..c45a3cb0f 100644 --- a/inst/tinytest/_tinysnapshot/escape-datasummary_escape_colnames_FALSE.txt +++ b/inst/tinytest/_tinysnapshot/escape-datasummary_escape_colnames_FALSE.txt @@ -4,9 +4,8 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=r,}, -column{3}={halign=r,}, +column{1}={}{halign=l,}, +column{2,3}={}{halign=r,}, } %% tabularray inner close \toprule & % & Money $$ \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-escape.html b/inst/tinytest/_tinysnapshot/escape-escape.html index 0f8fedce3..04087c96e 100644 --- a/inst/tinytest/_tinysnapshot/escape-escape.html +++ b/inst/tinytest/_tinysnapshot/escape-escape.html @@ -11,9 +11,16 @@
diff --git a/inst/tinytest/_tinysnapshot/escape-escape_html_false.html b/inst/tinytest/_tinysnapshot/escape-escape_html_false.html index 0f8fedce3..04087c96e 100644 --- a/inst/tinytest/_tinysnapshot/escape-escape_html_false.html +++ b/inst/tinytest/_tinysnapshot/escape-escape_html_false.html @@ -11,9 +11,16 @@
diff --git a/inst/tinytest/_tinysnapshot/escape-hat_I_formula.txt b/inst/tinytest/_tinysnapshot/escape-hat_I_formula.txt index 717575c64..7bfdae3b9 100644 --- a/inst/tinytest/_tinysnapshot/escape-hat_I_formula.txt +++ b/inst/tinytest/_tinysnapshot/escape-hat_I_formula.txt @@ -4,9 +4,9 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -hline{10}={1,2}{solid, 0.05em, black}, +column{2}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{10}={1,2}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-hat_fixest.txt b/inst/tinytest/_tinysnapshot/escape-hat_fixest.txt index 41bc9b909..04fa7e81f 100644 --- a/inst/tinytest/_tinysnapshot/escape-hat_fixest.txt +++ b/inst/tinytest/_tinysnapshot/escape-hat_fixest.txt @@ -4,9 +4,9 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -hline{4}={1,2}{solid, 0.05em, black}, +column{2}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{4}={1,2}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-issue707_01.txt b/inst/tinytest/_tinysnapshot/escape-issue707_01.txt index 25ffd2d3f..078edeef1 100644 --- a/inst/tinytest/_tinysnapshot/escape-issue707_01.txt +++ b/inst/tinytest/_tinysnapshot/escape-issue707_01.txt @@ -5,8 +5,8 @@ caption={blah\_blah}, ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, +column{2}={}{halign=c,}, +column{1}={}{halign=l,}, } %% tabularray inner close \toprule & (1) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-issue707_02.txt b/inst/tinytest/_tinysnapshot/escape-issue707_02.txt index de9dcfcd7..7ef3fcc22 100644 --- a/inst/tinytest/_tinysnapshot/escape-issue707_02.txt +++ b/inst/tinytest/_tinysnapshot/escape-issue707_02.txt @@ -5,9 +5,8 @@ caption={blah\_blah}, ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=r,}, -column{3}={halign=r,}, +column{1}={}{halign=l,}, +column{2,3}={}{halign=r,}, } %% tabularray inner close \toprule & mean & sd \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-issue707_03.txt b/inst/tinytest/_tinysnapshot/escape-issue707_03.txt index 1500c66d0..88e7a68ef 100644 --- a/inst/tinytest/_tinysnapshot/escape-issue707_03.txt +++ b/inst/tinytest/_tinysnapshot/escape-issue707_03.txt @@ -5,8 +5,8 @@ caption={blah_blah}, ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, +column{2}={}{halign=c,}, +column{1}={}{halign=l,}, } %% tabularray inner close \toprule & (1) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-issue707_04.txt b/inst/tinytest/_tinysnapshot/escape-issue707_04.txt index bc3288390..4e50c2a20 100644 --- a/inst/tinytest/_tinysnapshot/escape-issue707_04.txt +++ b/inst/tinytest/_tinysnapshot/escape-issue707_04.txt @@ -5,9 +5,8 @@ caption={blah_blah}, ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=r,}, -column{3}={halign=r,}, +column{1}={}{halign=l,}, +column{2,3}={}{halign=r,}, } %% tabularray inner close \toprule & mean & sd \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-latex.txt b/inst/tinytest/_tinysnapshot/escape-latex.txt index 35f243193..7619a11ac 100644 --- a/inst/tinytest/_tinysnapshot/escape-latex.txt +++ b/inst/tinytest/_tinysnapshot/escape-latex.txt @@ -4,10 +4,9 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -column{3}={halign=c,}, -hline{10}={1,2,3}{solid, 0.05em, black}, +column{2,3}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{10}={1,2,3}{solid, black, 0.05em}, } %% tabularray inner close \toprule & First\&Second & Third\_Fourth \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-modelsummary.html b/inst/tinytest/_tinysnapshot/escape-modelsummary.html index 934d15867..1429dde9b 100644 --- a/inst/tinytest/_tinysnapshot/escape-modelsummary.html +++ b/inst/tinytest/_tinysnapshot/escape-modelsummary.html @@ -11,9 +11,16 @@
diff --git a/inst/tinytest/_tinysnapshot/escape-modelsummary_latex.txt b/inst/tinytest/_tinysnapshot/escape-modelsummary_latex.txt index 604eb641b..362c0c663 100644 --- a/inst/tinytest/_tinysnapshot/escape-modelsummary_latex.txt +++ b/inst/tinytest/_tinysnapshot/escape-modelsummary_latex.txt @@ -4,11 +4,9 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -column{3}={halign=c,}, -column{4}={halign=c,}, -hline{6}={1,2,3,4}{solid, 0.05em, black}, +column{2,3,4}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{6}={1,2,3,4}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) & (2) & (3) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/escape-modelsummary_latex2.txt b/inst/tinytest/_tinysnapshot/escape-modelsummary_latex2.txt index a3bc403e1..71a517c20 100644 --- a/inst/tinytest/_tinysnapshot/escape-modelsummary_latex2.txt +++ b/inst/tinytest/_tinysnapshot/escape-modelsummary_latex2.txt @@ -4,11 +4,9 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -column{3}={halign=c,}, -column{4}={halign=c,}, -hline{6}={1,2,3,4}{solid, 0.05em, black}, +column{2,3,4}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{6}={1,2,3,4}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) & (2) & (3) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/html-gof_omit.html b/inst/tinytest/_tinysnapshot/html-gof_omit.html index e5eb889cb..6679c8c2b 100644 --- a/inst/tinytest/_tinysnapshot/html-gof_omit.html +++ b/inst/tinytest/_tinysnapshot/html-gof_omit.html @@ -11,9 +11,16 @@
From bc590aad56fb717053c0f8ea13e9a290d2c999d2 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sat, 16 Nov 2024 08:26:21 -0500 Subject: [PATCH 2/5] snapshots --- .../_tinysnapshot/mathmode-html_anything.html | 92 ++++++++----------- .../_tinysnapshot/mathmode-html_dollars.html | 92 ++++++++----------- .../_tinysnapshot/mathmode-latex_anything.txt | 7 +- .../_tinysnapshot/mathmode-latex_dollars.txt | 7 +- .../_tinysnapshot/mathmode-latex_ldd.txt | 8 +- .../_tinysnapshot/mathmode-latex_null.txt | 7 +- .../tinytest/_tinysnapshot/mathmode-null.html | 92 ++++++++----------- 7 files changed, 130 insertions(+), 175 deletions(-) diff --git a/inst/tinytest/_tinysnapshot/mathmode-html_anything.html b/inst/tinytest/_tinysnapshot/mathmode-html_anything.html index 493d834db..e9d53c392 100644 --- a/inst/tinytest/_tinysnapshot/mathmode-html_anything.html +++ b/inst/tinytest/_tinysnapshot/mathmode-html_anything.html @@ -11,9 +11,16 @@
diff --git a/inst/tinytest/_tinysnapshot/mathmode-html_dollars.html b/inst/tinytest/_tinysnapshot/mathmode-html_dollars.html index 6bad29243..e047f00af 100644 --- a/inst/tinytest/_tinysnapshot/mathmode-html_dollars.html +++ b/inst/tinytest/_tinysnapshot/mathmode-html_dollars.html @@ -25,9 +25,16 @@
diff --git a/inst/tinytest/_tinysnapshot/mathmode-latex_anything.txt b/inst/tinytest/_tinysnapshot/mathmode-latex_anything.txt index 9382cfb04..595662423 100644 --- a/inst/tinytest/_tinysnapshot/mathmode-latex_anything.txt +++ b/inst/tinytest/_tinysnapshot/mathmode-latex_anything.txt @@ -4,10 +4,9 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -column{3}={halign=c,}, -hline{8}={1,2,3}{solid, 0.05em, black}, +column{2,3}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{8}={1,2,3}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) & (2) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/mathmode-latex_dollars.txt b/inst/tinytest/_tinysnapshot/mathmode-latex_dollars.txt index b8f34968e..37dc338cc 100644 --- a/inst/tinytest/_tinysnapshot/mathmode-latex_dollars.txt +++ b/inst/tinytest/_tinysnapshot/mathmode-latex_dollars.txt @@ -4,10 +4,9 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -column{3}={halign=c,}, -hline{8}={1,2,3}{solid, 0.05em, black}, +column{2,3}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{8}={1,2,3}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) & (2) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/mathmode-latex_ldd.txt b/inst/tinytest/_tinysnapshot/mathmode-latex_ldd.txt index 4ab72fb5f..aaf287131 100644 --- a/inst/tinytest/_tinysnapshot/mathmode-latex_ldd.txt +++ b/inst/tinytest/_tinysnapshot/mathmode-latex_ldd.txt @@ -4,12 +4,12 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, column{2}={si={table-format=-3.3,table-align-text-before=false,table-align-text-after=false,input-symbols={-,\*+()}},}, -row{1}={guard}, +cell{1}{2}={guard,halign=c,}, column{3}={si={table-format=-3.3,table-align-text-before=false,table-align-text-after=false,input-symbols={-,\*+()}},}, -row{1}={guard}, -hline{8}={1,2,3}{solid, 0.05em, black}, +cell{1}{3}={guard,halign=c,}, +column{1}={}{halign=l,}, +hline{8}={1,2,3}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) & (2) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/mathmode-latex_null.txt b/inst/tinytest/_tinysnapshot/mathmode-latex_null.txt index d6060f54f..d29eba532 100644 --- a/inst/tinytest/_tinysnapshot/mathmode-latex_null.txt +++ b/inst/tinytest/_tinysnapshot/mathmode-latex_null.txt @@ -4,10 +4,9 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -column{3}={halign=c,}, -hline{8}={1,2,3}{solid, 0.05em, black}, +column{2,3}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{8}={1,2,3}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) & (2) \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/mathmode-null.html b/inst/tinytest/_tinysnapshot/mathmode-null.html index 58176e7a4..32c14a3a1 100644 --- a/inst/tinytest/_tinysnapshot/mathmode-null.html +++ b/inst/tinytest/_tinysnapshot/mathmode-null.html @@ -25,9 +25,16 @@
From fd20f53b16c3e4c8a06441eb3c6b802627960b54 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sat, 16 Nov 2024 08:53:46 -0500 Subject: [PATCH 3/5] snapshots --- DESCRIPTION | 2 +- NAMESPACE | 1 - R/modelsummary_wide.R | 8 --- .../rounding-datasummary_latex.txt | 5 +- .../_tinysnapshot/shape-multinom_wide.txt | 50 +++++++++++++++---- inst/tinytest/known_output/output-file.tex | 7 ++- man/modelsummary_wide.Rd | 12 ----- 7 files changed, 47 insertions(+), 38 deletions(-) delete mode 100644 R/modelsummary_wide.R delete mode 100644 man/modelsummary_wide.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 6df0b91a8..1b9978af4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,3 +1,4 @@ +Remotes: vincentarelbundock/tinytable Type: Package Package: modelsummary Title: Summary Tables and Plots for Statistical Models and Data: Beautiful, Customizable, and Publication-Ready @@ -181,7 +182,6 @@ Collate: 'modelsummary_cbind.R' 'modelsummary_list.R' 'modelsummary_rbind.R' - 'modelsummary_wide.R' 'poorman.R' 'reexport.R' 'rename_statistics.R' diff --git a/NAMESPACE b/NAMESPACE index ba14ac588..f79c4aa13 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -65,7 +65,6 @@ export(gof_map) export(labelSubset) export(modelplot) export(modelsummary) -export(modelsummary_wide) export(msummary) export(rowLabels) export(supported_models) diff --git a/R/modelsummary_wide.R b/R/modelsummary_wide.R deleted file mode 100644 index b84a28990..000000000 --- a/R/modelsummary_wide.R +++ /dev/null @@ -1,8 +0,0 @@ -#' Superseded function -#' -#' This function is superseded by the `shape` argument of the `modelsummary` function. -#' @keywords internal -#' @export -modelsummary_wide <- function(...) { - stop("The `modelsummary_wide` is replaced by the `shape` argument of the `modelsummary` function.", call. = FALSE) -} diff --git a/inst/tinytest/_tinysnapshot/rounding-datasummary_latex.txt b/inst/tinytest/_tinysnapshot/rounding-datasummary_latex.txt index 4cd2cbfe3..bd079ca3b 100644 --- a/inst/tinytest/_tinysnapshot/rounding-datasummary_latex.txt +++ b/inst/tinytest/_tinysnapshot/rounding-datasummary_latex.txt @@ -4,9 +4,8 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=r,}, -column{3}={halign=r,}, +column{1}={}{halign=l,}, +column{2,3}={}{halign=r,}, } %% tabularray inner close \toprule cyl & SD & N \\ \midrule %% TinyTableHeader diff --git a/inst/tinytest/_tinysnapshot/shape-multinom_wide.txt b/inst/tinytest/_tinysnapshot/shape-multinom_wide.txt index eb63cfe47..68b2fc6f5 100644 --- a/inst/tinytest/_tinysnapshot/shape-multinom_wide.txt +++ b/inst/tinytest/_tinysnapshot/shape-multinom_wide.txt @@ -4,15 +4,47 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]Q[]Q[]}, -cell{1}{2}={c=2,}{halign=c,}, -cell{1}{4}={c=2,}{halign=c,}, -column{1}={halign=l,}, -column{2}={halign=c,}, -column{3}={halign=c,}, -column{4}={halign=c,}, -column{5}={halign=c,}, -row{1}={halign=c,}, -hline{5}={1,2,3,4,5}{solid, 0.05em, black}, +cell{2}{2}={}{halign=c,}, +cell{2}{3}={}{halign=c,}, +cell{2}{4}={}{halign=c,}, +cell{2}{5}={}{halign=c,}, +cell{3}{2}={}{halign=c,}, +cell{3}{3}={}{halign=c,}, +cell{3}{4}={}{halign=c,}, +cell{3}{5}={}{halign=c,}, +cell{4}{2}={}{halign=c,}, +cell{4}{3}={}{halign=c,}, +cell{4}{4}={}{halign=c,}, +cell{4}{5}={}{halign=c,}, +cell{5}{2}={}{halign=c,}, +cell{5}{3}={}{halign=c,}, +cell{5}{4}={}{halign=c,}, +cell{5}{5}={}{halign=c,}, +cell{6}{2}={}{halign=c,}, +cell{6}{3}={}{halign=c,}, +cell{6}{4}={}{halign=c,}, +cell{6}{5}={}{halign=c,}, +cell{7}{2}={}{halign=c,}, +cell{7}{3}={}{halign=c,}, +cell{7}{4}={}{halign=c,}, +cell{7}{5}={}{halign=c,}, +cell{8}{2}={}{halign=c,}, +cell{8}{3}={}{halign=c,}, +cell{8}{4}={}{halign=c,}, +cell{8}{5}={}{halign=c,}, +cell{1}{3}={}{halign=c, halign=c,}, +cell{1}{5}={}{halign=c, halign=c,}, +cell{2}{1}={}{halign=l,}, +cell{3}{1}={}{halign=l,}, +cell{4}{1}={}{halign=l,}, +cell{5}{1}={}{halign=l,}, +cell{6}{1}={}{halign=l,}, +cell{7}{1}={}{halign=l,}, +cell{8}{1}={}{halign=l,}, +cell{1}{1}={}{halign=l, halign=c,}, +cell{1}{2}={c=2,}{halign=c, halign=c, halign=c,}, +cell{1}{4}={c=2,}{halign=c, halign=c, halign=c,}, +hline{5}={1,2,3,4,5}{solid, black, 0.05em}, } %% tabularray inner close \toprule & a & & b & \\ \cmidrule[lr]{2-3}\cmidrule[lr]{4-5} diff --git a/inst/tinytest/known_output/output-file.tex b/inst/tinytest/known_output/output-file.tex index a82a11243..a91da76da 100644 --- a/inst/tinytest/known_output/output-file.tex +++ b/inst/tinytest/known_output/output-file.tex @@ -4,10 +4,9 @@ ] %% tabularray outer close { %% tabularray inner open colspec={Q[]Q[]Q[]}, -column{1}={halign=l,}, -column{2}={halign=c,}, -column{3}={halign=c,}, -hline{8}={1,2,3}{solid, 0.05em, black}, +column{2,3}={}{halign=c,}, +column{1}={}{halign=l,}, +hline{8}={1,2,3}{solid, black, 0.05em}, } %% tabularray inner close \toprule & (1) & (2) \\ \midrule %% TinyTableHeader diff --git a/man/modelsummary_wide.Rd b/man/modelsummary_wide.Rd deleted file mode 100644 index 6f76655a6..000000000 --- a/man/modelsummary_wide.Rd +++ /dev/null @@ -1,12 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/modelsummary_wide.R -\name{modelsummary_wide} -\alias{modelsummary_wide} -\title{Superseded function} -\usage{ -modelsummary_wide(...) -} -\description{ -This function is superseded by the \code{shape} argument of the \code{modelsummary} function. -} -\keyword{internal} From 764d924b616482aaa615f57b395bcf74f8a0a34b Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sat, 16 Nov 2024 09:01:45 -0500 Subject: [PATCH 4/5] no more kableExtra warning --- R/datasummary.R | 43 +-- R/datasummary_balance.R | 518 ++++++++++++++--------------- R/datasummary_correlation.R | 85 +++-- R/datasummary_crosstab.R | 226 ++++++------- R/datasummary_df.R | 27 +- R/datasummary_skim.R | 157 +++++---- R/modelsummary.R | 469 +++++++++++++------------- R/zzz.R | 18 +- man-roxygen/kableExtra2tinytable.R | 10 + man/datasummary.Rd | 13 + man/datasummary_balance.Rd | 13 + man/datasummary_correlation.Rd | 13 + man/datasummary_crosstab.Rd | 15 +- man/datasummary_df.Rd | 13 + man/datasummary_skim.Rd | 13 + man/dsummary.Rd | 13 + man/modelsummary.Rd | 98 +++--- man/msummary.Rd | 98 +++--- 18 files changed, 978 insertions(+), 864 deletions(-) create mode 100644 man-roxygen/kableExtra2tinytable.R diff --git a/R/datasummary.R b/R/datasummary.R index 08bb73d75..c9781ce06 100644 --- a/R/datasummary.R +++ b/R/datasummary.R @@ -5,14 +5,16 @@ #' `datasummary` can use any summary function which produces one numeric or #' character value per variable. The examples section of this documentation #' shows how to define custom summary functions. -#' -#' `modelsummary` also supplies several shortcut summary functions which can be used in `datasummary()` formulas: Min, Max, Mean, Median, Var, SD, NPercent, NUnique, Ncol, P0, P25, P50, P75, P100. -#' -#' See the Details and Examples sections below, and the vignettes on the `modelsummary` website: #' -#' * https://modelsummary.com/ +#' `modelsummary` also supplies several shortcut summary functions which can be used in `datasummary()` formulas: Min, Max, Mean, Median, Var, SD, NPercent, NUnique, Ncol, P0, P25, P50, P75, P100. +#' +#' See the Details and Examples sections below, and the vignettes on the `modelsummary` website: +#' +#' * https://modelsummary.com/ #' * https://modelsummary.com/articles/datasummary.html #' +#' @template kableExtra2tinytable +#' #' @inheritParams modelsummary #' @import tables #' @param formula A two-sided formula to describe the table: rows ~ columns. @@ -24,7 +26,7 @@ #' your main table. #' @param fmt how to format numeric values: integer, user-supplied function, or `modelsummary` function. #' * Integer: Number of decimal digits -#' * User-supplied functions: +#' * User-supplied functions: #' - Any function which accepts a numeric vector and returns a character vector of the same length. #' * `modelsummary` functions: #' - `fmt = fmt_significant(2)`: Two significant digits (at the term-level) @@ -46,7 +48,7 @@ #' #' ```{r, eval = identical(Sys.getenv("pkgdown"), "true")} #' library(modelsummary) -#' +#' #' # The left-hand side of the formula describes rows, and the right-hand side #' # describes columns. This table uses the "mpg" variable as a row and the "mean" #' # function as a column: @@ -150,7 +152,7 @@ #' @export datasummary <- function(formula, data, - output = 'default', + output = "default", fmt = 2, title = NULL, notes = NULL, @@ -160,7 +162,6 @@ datasummary <- function(formula, sparse_header = TRUE, escape = TRUE, ...) { - if (!isTRUE(list(...)[["internal_call"]])) { ## settings: don't overwrite settings on internal calls settings_init(settings = list( @@ -168,7 +169,7 @@ datasummary <- function(formula, )) } - tmp <- sanitize_output(output) # early + tmp <- sanitize_output(output) # early output_format <- tmp$output_format output_factory <- tmp$output_factory output_file <- tmp$output_file @@ -196,8 +197,8 @@ datasummary <- function(formula, tab <- tryCatch(tables::tabular(formula, data), error = function(e) e) # informative error message - if (inherits(tab, 'error')) { - if (grepl('Duplicate values:', tab$message)) { + if (inherits(tab, "error")) { + if (grepl("Duplicate values:", tab$message)) { message('This error often occurs when the "*" nesting operator is used, but none of the nested terms are categorical variables (factor, logical or character types). You can transform your variable in the original data, or wrap it in a Factor() function in the `datasummary` formula.') } stop(tab$message) @@ -210,20 +211,21 @@ datasummary <- function(formula, data = data) # align stub l rest r - stub_width <- attr(dse, 'stub_width') + stub_width <- attr(dse, "stub_width") tab_width <- ncol(dse) - if (inherits(add_columns, 'data.frame')) { + if (inherits(add_columns, "data.frame")) { tab_width <- tab_width + ncol(add_columns) } if (is.null(align)) { - align <- paste0(strrep('l', stub_width), - strrep('r', tab_width - stub_width)) + align <- paste0( + strrep("l", stub_width), + strrep("r", tab_width - stub_width)) } align <- paste(align, collapse = "") # convert to numeric if fmt==NULL if (is.null(fmt)) { - idx <- attr(dse, 'stub_width') + idx <- attr(dse, "stub_width") for (i in (idx + 1):ncol(dse)) { dse[[i]] <- as.numeric(dse[[i]]) } @@ -247,16 +249,15 @@ datasummary <- function(formula, # invisible return if (!is.null(output_file) || - output == "jupyter" || - (output == "default" && settings_equal("output_default", "jupyter"))) { + output == "jupyter" || + (output == "default" && settings_equal("output_default", "jupyter"))) { if (!isTRUE(list(...)[["internal_call"]])) settings_rm() return(invisible(out)) - # visible return + # visible return } else { if (!isTRUE(list(...)[["internal_call"]])) settings_rm() return(out) } - } #' `dsummary()` is a shortcut to `datasummary()` diff --git a/R/datasummary_balance.R b/R/datasummary_balance.R index 503b8c6fb..eeed90c3e 100644 --- a/R/datasummary_balance.R +++ b/R/datasummary_balance.R @@ -4,11 +4,11 @@ #' Creates balance tables with summary statistics for different subsets of the #' data (e.g., control and treatment groups). It can also be used to create #' summary tables for full data sets. See the Details and Examples sections -#' below, and the vignettes on the `modelsummary` website: +#' below, and the vignettes on the `modelsummary` website: #' * https://modelsummary.com/ #' * https://modelsummary.com/articles/datasummary.html #' -#' @param formula +#' @param formula #' + `~1`: show summary statistics for the full dataset #' + one-sided formula: with the "condition" or "column" variable on the right-hand side. #' + two-side formula: with the subset of variables to summarize on the left-hand side and the condition variable on the right-hand side. @@ -24,6 +24,7 @@ #' @param dinm_statistic string: "std.error" or "p.value" #' @inheritParams datasummary #' @inheritParams modelsummary +#' @template kableExtra2tinytable #' @template citation #' @template options #' @export @@ -46,268 +47,272 @@ datasummary_balance <- function(formula, dinm_statistic = "std.error", escape = TRUE, ...) { + ## settings + settings_init(settings = list("function_called" = "datasummary_balance")) + + ## sanity checks + tmp <- sanitize_output(output) # before sanitize_escape + output_format <- tmp$output_format + output_factory <- tmp$output_factory + output_file <- tmp$output_file + + # this is going to be detected by fmt_mathmode() when we call + # datasummary(output="dataframe") so we can get siunitx formatting even in + # internal calls. + settings_set("output_format_ultimate", output_format) + + sanity_align(align) + sanitize_escape(escape) # after sanitize_output + sanity_ds_right_handed_formula(formula) + sanity_stars(stars) + checkmate::assert_formula(formula) + checkmate::assert_data_frame(data, min.rows = 1, min.cols = 1) + checkmate::assert_flag(dinm) + checkmate::assert_choice(dinm_statistic, choices = c("std.error", "p.value")) + data <- sanitize_datasummary_balance_data(formula, data) + + + if ("p.value" %in% dinm_statistic) { + insight::check_if_installed("estimatr") + } + ## rhs condition variable + rhs <- labels(stats::terms(formula)) - ## settings - settings_init(settings = list("function_called" = "datasummary_balance")) - - ## sanity checks - tmp <- sanitize_output(output) # before sanitize_escape - output_format <- tmp$output_format - output_factory <- tmp$output_factory - output_file <- tmp$output_file - - # this is going to be detected by fmt_mathmode() when we call - # datasummary(output="dataframe") so we can get siunitx formatting even in - # internal calls. - settings_set("output_format_ultimate", output_format) - - sanity_align(align) - sanitize_escape(escape) # after sanitize_output - sanity_ds_right_handed_formula(formula) - sanity_stars(stars) - checkmate::assert_formula(formula) - checkmate::assert_data_frame(data, min.rows = 1, min.cols = 1) - checkmate::assert_flag(dinm) - checkmate::assert_choice(dinm_statistic, choices = c("std.error", "p.value")) - data <- sanitize_datasummary_balance_data(formula, data) - - - if ("p.value" %in% dinm_statistic) { - insight::check_if_installed("estimatr") - } + ## haven labels are not supported. Implementation is complicated because + ## tables::All() does not accept labels, so we need to strip them from the + ## dataset used in formulas, but not from the actual `data` argument. + flag <- any(sapply(data, inherits, "haven_labelled")) + if (isTRUE(flag)) { + data <- strip_labels(data) + warn_once( + msg = "Labelled data are not supported by the `datasummary_balance()` function.", + id = "balance haven labels" + ) + } - ## rhs condition variable - rhs <- labels(stats::terms(formula)) - - ## haven labels are not supported. Implementation is complicated because - ## tables::All() does not accept labels, so we need to strip them from the - ## dataset used in formulas, but not from the actual `data` argument. - flag <- any(sapply(data, inherits, "haven_labelled")) - if (isTRUE(flag)) { - data <- strip_labels(data) - warn_once( - msg = "Labelled data are not supported by the `datasummary_balance()` function.", - id = "balance haven labels" - ) - } + if (formula == ~1) { + # No groups to calculate mean differences + dinm <- FALSE + rhs <- NULL + } else { + ## nobs in column spans via factor levels + lev <- table(data[[rhs]]) + lev <- paste0(names(lev), " (N=", lev, ")") + levels(data[[rhs]]) <- lev + } - if (formula == ~1) { - #No groups to calculate mean differences - dinm <- FALSE - rhs <- NULL - } else { - ## nobs in column spans via factor levels - lev <- table(data[[rhs]]) - lev <- paste0(names(lev), " (N=", lev, ")") - levels(data[[rhs]]) <- lev - } + ## exclude otherwise All() makes them appear as rows + idx <- setdiff(colnames(data), c(rhs, "clusters", "blocks", "weights")) + data_norhs <- data[, idx, drop = FALSE] - ## exclude otherwise All() makes them appear as rows - idx <- setdiff(colnames(data), c(rhs, "clusters", "blocks", "weights")) - data_norhs <- data[, idx, drop = FALSE] + ## 3-parts table: numeric + dinm / factor + any_numeric <- any(sapply(data_norhs, is.numeric)) + any_factor <- any(sapply(data_norhs, is.factor)) + n_factor <- sum(sapply(data_norhs, is.factor)) - ## 3-parts table: numeric + dinm / factor - any_numeric <- any(sapply(data_norhs, is.numeric)) - any_factor <- any(sapply(data_norhs, is.factor)) - n_factor <- sum(sapply(data_norhs, is.factor)) + ## difference in means + if (!any_numeric) { + dinm <- FALSE + } - ## difference in means - if (!any_numeric) { - dinm <- FALSE - } + if (dinm && !isTRUE(check_dependency("estimatr"))) { + dinm <- FALSE + warning("Please install the `estimatr` package or set `dinm=FALSE` to suppress this warning.", + call. = FALSE) + } - if (dinm && !isTRUE(check_dependency("estimatr"))) { - dinm <- FALSE - warning("Please install the `estimatr` package or set `dinm=FALSE` to suppress this warning.", - call. = FALSE) - } + if (dinm && (length(unique(data[[rhs]])) > 2)) { + dinm <- FALSE + warning("The difference in means can only be calculate with two groups in the right-hand side variable. Set `dinm=FALSE` to suppress this warning.", + call. = FALSE) + } - if (dinm && (length(unique(data[[rhs]])) > 2)) { - dinm <- FALSE - warning("The difference in means can only be calculate with two groups in the right-hand side variable. Set `dinm=FALSE` to suppress this warning.", - call. = FALSE) + ## factors + if (any_factor) { + ## enforce 2-column stub, even when there is only one factor + tmp1 <- data + tmp2 <- data_norhs + tmp1$bad_factor_for_stub <- as.factor(sample(c("A", "B"), nrow(tmp1), replace = TRUE)) + tmp2$bad_factor_for_stub <- as.factor(sample(c("A", "B"), nrow(tmp2), replace = TRUE)) + + # pctformat = function(x) sprintf("%.1f", x) + pctformat <- sanitize_fmt(1) + nformat <- function(x) { + sanitize_fmt(0)(as.numeric(x)) } - - ## factors - if (any_factor) { - - ## enforce 2-column stub, even when there is only one factor - tmp1 <- data - tmp2 <- data_norhs - tmp1$bad_factor_for_stub <- as.factor(sample(c("A", "B"), nrow(tmp1), replace = TRUE)) - tmp2$bad_factor_for_stub <- as.factor(sample(c("A", "B"), nrow(tmp2), replace = TRUE)) - - # pctformat = function(x) sprintf("%.1f", x) - pctformat <- sanitize_fmt(1) - nformat <- function(x) { - sanitize_fmt(0)(as.numeric(x)) - } - if (!is.null(rhs)) { - f_fac <- stats::as.formula(sprintf( - "All(tmp2, factor = TRUE, numeric = FALSE) ~ + if (!is.null(rhs)) { + f_fac <- stats::as.formula(sprintf( + "All(tmp2, factor = TRUE, numeric = FALSE) ~ Factor(%s) * (N * Format(nformat()) + Heading('Pct.') * Percent('col') * Format(pctformat()))", rhs)) - } else { - f_fac <- stats::as.formula( - "All(tmp2, factor = TRUE, numeric = FALSE) ~ + } else { + f_fac <- stats::as.formula( + "All(tmp2, factor = TRUE, numeric = FALSE) ~ (N * Format(nformat()) + Heading('Pct.') * Percent('col') * Format(pctformat()))") - } - tab_fac <- datasummary(formula = f_fac, - data = tmp1, - fmt = fmt, - internal_call = TRUE, - output = "data.frame") - - ## datasummary(output="dataframe") changes the output format - sanitize_output(output) - settings_set("output_format_ultimate", output_format) - - ## enforce 2-column stub, even when there is only one factor - idx <- grep("bad_factor_for_stub", tab_fac[[1]]) - tab_fac <- tab_fac[1:(idx - 1), , drop = FALSE] } + tab_fac <- datasummary( + formula = f_fac, + data = tmp1, + fmt = fmt, + internal_call = TRUE, + output = "data.frame") + + ## datasummary(output="dataframe") changes the output format + sanitize_output(output) + settings_set("output_format_ultimate", output_format) - ## numerics - if (any_numeric) { - ## tab_fac has 2 stub columns when there is more than one factor, but only 1 otherwise - emptyfun <- function(x) return(" ") - empty <- ifelse(any_factor, "Heading(' ') * emptyfun + ", "") - # weights - if ("weights" %in% colnames(data)) { - #Grouped - if(!is.null(rhs)) { - f_num <- "All(data_norhs) ~ %s Factor(%s) * ( + ## enforce 2-column stub, even when there is only one factor + idx <- grep("bad_factor_for_stub", tab_fac[[1]]) + tab_fac <- tab_fac[1:(idx - 1), , drop = FALSE] + } + + ## numerics + if (any_numeric) { + ## tab_fac has 2 stub columns when there is more than one factor, but only 1 otherwise + emptyfun <- function(x) { + return(" ") + } + empty <- ifelse(any_factor, "Heading(' ') * emptyfun + ", "") + # weights + if ("weights" %in% colnames(data)) { + # Grouped + if (!is.null(rhs)) { + f_num <- "All(data_norhs) ~ %s Factor(%s) * ( Heading('Mean') * weighted.mean * Arguments(w = weights, na.rm = TRUE) + Heading('Std. Dev.') * modelsummary:::weighted_sd * Arguments(w = weights))" - f_num <- stats::as.formula(sprintf(f_num, empty, rhs)) - #No groups - } else { - f_num <- "All(data_norhs) ~ %s ( + f_num <- stats::as.formula(sprintf(f_num, empty, rhs)) + # No groups + } else { + f_num <- "All(data_norhs) ~ %s ( Heading('Mean') * weighted.mean * Arguments(w = weights, na.rm = TRUE) + Heading('Std. Dev.') * modelsummary:::weighted_sd * Arguments(w = weights))" - f_num <- stats::as.formula(sprintf(f_num, empty)) - } - # no weights - } else { - #Grouped - if(!is.null(rhs)) { - f_num <- "All(data_norhs) ~ %s Factor(%s) * (Mean + Heading('Std. Dev.') * SD)" - f_num <- stats::as.formula(sprintf(f_num, empty, rhs)) - #No groups - } else { - f_num <- "All(data_norhs) ~ %s (Mean + Heading('Std. Dev.') * SD)" - f_num <- stats::as.formula(sprintf(f_num, empty)) - } - } - tab_num <- datasummary(formula = f_num, - fmt = fmt, - data = data, - internal_call = TRUE, - output = "data.frame") - - ## datasummary(output="dataframe") changes the output format - sanitize_output(output) - settings_set("output_format_ultimate", output_format) + f_num <- stats::as.formula(sprintf(f_num, empty)) + } + # no weights + } else { + # Grouped + if (!is.null(rhs)) { + f_num <- "All(data_norhs) ~ %s Factor(%s) * (Mean + Heading('Std. Dev.') * SD)" + f_num <- stats::as.formula(sprintf(f_num, empty, rhs)) + # No groups + } else { + f_num <- "All(data_norhs) ~ %s (Mean + Heading('Std. Dev.') * SD)" + f_num <- stats::as.formula(sprintf(f_num, empty)) + } } + tab_num <- datasummary( + formula = f_num, + fmt = fmt, + data = data, + internal_call = TRUE, + output = "data.frame") + + ## datasummary(output="dataframe") changes the output format + sanitize_output(output) + settings_set("output_format_ultimate", output_format) + } - ## combine - if (any_numeric && any_factor) { - top <- tab_num - mid <- attr(get_span_kableExtra(tab_fac), "column_names") - if (is.null(mid)) { - mid <- colnames(tab_fac) - } else { - mid <- trimws(mid) - } - mid <- stats::setNames(as.data.frame(as.list(mid)), colnames(top)) - bot <- stats::setNames(tab_fac, colnames(top)) - tab <- bind_rows(top, mid, bot) - - ## restore attributes destroyed by bind_rows - idx <- grep("header|stub|align", names(attributes(tab_num)), value = TRUE) - for (i in idx) { - attr(tab, i) <- attr(tab_num, i) - } - ## empty numeric column looks real but is actually a stub - attr(tab, "stub_width") <- attr(tab_fac, "stub_width") - - } else if (any_numeric) { - tab <- tab_num - } else if (any_factor) { - tab <- tab_fac + ## combine + if (any_numeric && any_factor) { + top <- tab_num + mid <- attr(get_span_kableExtra(tab_fac), "column_names") + if (is.null(mid)) { + mid <- colnames(tab_fac) } else { - stop("The `datasummary_balance` function was unable to extract summary statistics.") + mid <- trimws(mid) } - - ## differences in means for numeric variables - if (any_numeric && isTRUE(dinm)) { - ## dinm - numeric_variables <- colnames(data_norhs)[sapply(data_norhs, is.numeric)] - tmp <- lapply(numeric_variables, - function(lhs) DinM(lhs = lhs, - rhs = rhs, - data = data, - fmt = fmt, - statistic = dinm_statistic, - stars = stars, - escape = escape)) - tmp <- do.call("rbind", tmp) - - ## use poorman's left_join because merge breaks the order, even with sort=FALSE - ## this also protects attributes - tab <- left_join(tab, tmp, by = " ") - - tab[is.na(tab)] <- "" + mid <- stats::setNames(as.data.frame(as.list(mid)), colnames(top)) + bot <- stats::setNames(tab_fac, colnames(top)) + tab <- bind_rows(top, mid, bot) + + ## restore attributes destroyed by bind_rows + idx <- grep("header|stub|align", names(attributes(tab_num)), value = TRUE) + for (i in idx) { + attr(tab, i) <- attr(tab_num, i) } + ## empty numeric column looks real but is actually a stub + attr(tab, "stub_width") <- attr(tab_fac, "stub_width") + } else if (any_numeric) { + tab <- tab_num + } else if (any_factor) { + tab <- tab_fac + } else { + stop("The `datasummary_balance` function was unable to extract summary statistics.") + } - ## horizontal rule - if (any_factor && any_numeric) { - hrule <- nrow(tab_num) + 1 - } else { - hrule <- NULL - } + ## differences in means for numeric variables + if (any_numeric && isTRUE(dinm)) { + ## dinm + numeric_variables <- colnames(data_norhs)[sapply(data_norhs, is.numeric)] + tmp <- lapply( + numeric_variables, + function(lhs) { + DinM( + lhs = lhs, + rhs = rhs, + data = data, + fmt = fmt, + statistic = dinm_statistic, + stars = stars, + escape = escape) + }) + tmp <- do.call("rbind", tmp) + + ## use poorman's left_join because merge breaks the order, even with sort=FALSE + ## this also protects attributes + tab <- left_join(tab, tmp, by = " ") + + tab[is.na(tab)] <- "" + } - ## align: default (TODO: `add_columns` support) - if (is.null(align) && !is.null(attr(tab, "stub_width")) && is.null(add_columns)) { - align <- paste0(strrep("l", attr(tab, "stub_width")), - strrep("r", ncol(tab) - attr(tab, "stub_width"))) - } + ## horizontal rule + if (any_factor && any_numeric) { + hrule <- nrow(tab_num) + 1 + } else { + hrule <- NULL + } - ## weights warning - if (isTRUE(any_factor) && "weights" %in% colnames(data)) { - msg <- 'When the `data` used in `datasummary_balance` contains a "weights" column, the means, standard deviations, difference in means, and standard errors of numeric variables are adjusted to account for weights. However, the counts and percentages for categorical variables are not adjusted.' - warning(msg, call. = FALSE) - } + ## align: default (TODO: `add_columns` support) + if (is.null(align) && !is.null(attr(tab, "stub_width")) && is.null(add_columns)) { + align <- paste0( + strrep("l", attr(tab, "stub_width")), + strrep("r", ncol(tab) - attr(tab, "stub_width"))) + } - ## make table - out <- factory( - tab, - align = align, - hrule = hrule, - notes = notes, - fmt = fmt, - output = output, - add_rows = add_rows, - add_columns = add_columns, - title = title, - escape = escape, - output_factory = output_factory, - output_format = output_format, - output_file = output_file, - ...) - - # invisible return - if (!is.null(output_file) || - output == "jupyter" || - (output == "default" && settings_equal("output_default", "jupyter"))) { - settings_rm() - return(invisible(out)) - # visible return - } else { - settings_rm() - return(out) - } + ## weights warning + if (isTRUE(any_factor) && "weights" %in% colnames(data)) { + msg <- 'When the `data` used in `datasummary_balance` contains a "weights" column, the means, standard deviations, difference in means, and standard errors of numeric variables are adjusted to account for weights. However, the counts and percentages for categorical variables are not adjusted.' + warning(msg, call. = FALSE) + } + ## make table + out <- factory( + tab, + align = align, + hrule = hrule, + notes = notes, + fmt = fmt, + output = output, + add_rows = add_rows, + add_columns = add_columns, + title = title, + escape = escape, + output_factory = output_factory, + output_format = output_format, + output_file = output_file, + ...) + + # invisible return + if (!is.null(output_file) || + output == "jupyter" || + (output == "default" && settings_equal("output_default", "jupyter"))) { + settings_rm() + return(invisible(out)) + # visible return + } else { + settings_rm() + return(out) + } } @@ -315,17 +320,16 @@ datasummary_balance <- function(formula, #' #' @noRd DinM <- function(lhs, rhs, data, fmt, statistic, stars = TRUE, escape = TRUE) { - insight::check_if_installed("estimatr") if (!"clusters" %in% colnames(data)) { - clusters <- NULL + clusters <- NULL } if (!"weights" %in% colnames(data)) { - weights <- NULL + weights <- NULL } if (!"blocks" %in% colnames(data)) { - blocks <- NULL + blocks <- NULL } # needed for names with spaces @@ -367,7 +371,6 @@ DinM <- function(lhs, rhs, data, fmt, statistic, stars = TRUE, escape = TRUE) { } out - } @@ -376,7 +379,6 @@ DinM <- function(lhs, rhs, data, fmt, statistic, stars = TRUE, escape = TRUE) { #' @noRd #' @keywords internal sanitize_datasummary_balance_data <- function(formula, data) { - # tables::tabular does not play well with tibbles data <- as.data.frame(data) @@ -394,25 +396,24 @@ sanitize_datasummary_balance_data <- function(formula, data) { if (length(lhs) > 0) { cols <- intersect(c(lhs, rhs), colnames(data)) if (length(cols) > 1) { - data <- data[, cols, drop = FALSE] + data <- data[, cols, drop = FALSE] } } - - if (formula != ~1) { - - if (!rhs %in% colnames(data)) { - stop("Variable ", rhs, " must be in data.") - } + if (formula != ~1) { + if (!rhs %in% colnames(data)) { + stop("Variable ", rhs, " must be in data.") + } - if (length(unique(data[[rhs]])) > 10) { - stop(sprintf("Each value of the `%s` variable will create two separate columns. This variable has more than 10 unique values, so the table would be too wide to be readable.", - rhs)) - } - data <- data[!is.na(data[[rhs]]), , drop = FALSE] + if (length(unique(data[[rhs]])) > 10) { + stop(sprintf( + "Each value of the `%s` variable will create two separate columns. This variable has more than 10 unique values, so the table would be too wide to be readable.", + rhs)) + } + data <- data[!is.na(data[[rhs]]), , drop = FALSE] } else { - #No grouping variable - summarise full dataset - rhs <- NULL + # No grouping variable - summarise full dataset + rhs <- NULL } if ("weights" %in% colnames(data)) { @@ -437,7 +438,6 @@ sanitize_datasummary_balance_data <- function(formula, data) { data[[n]] <- NULL drop_entirely_na <- c(drop_entirely_na, n) } else { - # factors with too many levels if (is.factor(data[[n]])) { if (length(levels(data[[n]])) > 50) { @@ -451,12 +451,12 @@ sanitize_datasummary_balance_data <- function(formula, data) { if (!is.null(drop_too_many_levels)) { warning(sprintf("These variables were omitted because they include more than 50 levels: %s.", paste(drop_too_many_levels, collapse = ", ")), - call. = FALSE) + call. = FALSE) } if (!is.null(drop_entirely_na)) { warning(sprintf("These variables were omitted because they are entirely missing: %s.", paste(drop_entirely_na, collapse = ", ")), - call. = FALSE) + call. = FALSE) } return(data) diff --git a/R/datasummary_correlation.R b/R/datasummary_correlation.R index f8f9e70d0..a527ba4a5 100644 --- a/R/datasummary_correlation.R +++ b/R/datasummary_correlation.R @@ -3,7 +3,7 @@ #' The names of the variables displayed in the correlation table are the names #' of the columns in the `data`. You can rename those columns (with or without #' spaces) to produce a table of human-readable variables. See the Details and -#' Examples sections below, and the vignettes on the `modelsummary` website: +#' Examples sections below, and the vignettes on the `modelsummary` website: #' * https://modelsummary.com/ #' * https://modelsummary.com/articles/datasummary.html #' @@ -19,6 +19,7 @@ #' `datasummary_correlation_format` can often be useful for formatting the #' output of custom correlation functions. #' } +#' @template kableExtra2tinytable #' @template citation #' @template options #' @param ... other parameters are passed through to the table-making @@ -39,12 +40,12 @@ #' select(`Miles / Gallon` = mpg, #' `Horse Power` = hp) #' datasummary_correlation(dat) -#' +#' #' # `correlation` package objects #' if (requireNamespace("correlation", quietly = TRUE)) { #' co <- correlation::correlation(mtcars[, 1:4]) #' datasummary_correlation(co) -#' +#' #' # add stars to easycorrelation objects #' datasummary_correlation(co, stars = TRUE) #' } @@ -107,7 +108,7 @@ #' datasummary_correlation(dat, method = cor_fun, escape = FALSE) #' ``` datasummary_correlation <- function(data, - output = 'default', + output = "default", method = "pearson", fmt = 2, align = NULL, @@ -118,8 +119,6 @@ datasummary_correlation <- function(data, escape = TRUE, stars = FALSE, ...) { - - ## settings settings_init(settings = list( "function_called" = "datasummary_correlation" @@ -137,12 +136,12 @@ datasummary_correlation <- function(data, if (inherits(data, "data.table")) { data <- as.data.frame(data, check.names = FALSE) } - + easycorrelation <- inherits(data, "easycorrelation") if (isFALSE(easycorrelation) && !isFALSE(stars)) { - msg <- "The `stars` argument of the `datasummary_correlation()` function is only supported when `x` is an object produced by the `correlation` package." - insight::format_error(msg) + msg <- "The `stars` argument of the `datasummary_correlation()` function is only supported when `x` is an object produced by the `correlation` package." + insight::format_error(msg) } if (easycorrelation) { @@ -154,8 +153,8 @@ datasummary_correlation <- function(data, # store the p values in a "attribute" of the object # this is retrieved and used in the `_format()` function. attr(data, "p") <- attr(s, "p") - } - + } + any_numeric <- any(sapply(data, is.numeric) == TRUE) if (any_numeric == FALSE) { stop("`datasummary_correlation` can only summarize numeric data columns.") @@ -173,11 +172,13 @@ datasummary_correlation <- function(data, } else if (method == "pearspear") { fn <- correlation_pearspear } else { - fn <- function(x) stats::cor( - x, - use = "pairwise.complete.obs", - method = method) - } + fn <- function(x) { + stats::cor( + x, + use = "pairwise.complete.obs", + method = method) + } + } # subset numeric and compute correlation if (easycorrelation == FALSE) { @@ -189,19 +190,19 @@ datasummary_correlation <- function(data, } if ((!is.matrix(out) && !inherits(out, "data.frame")) || - is.null(row.names(out)) || - is.null(colnames(out)) || - nrow(out) != ncol(out)) { + is.null(row.names(out)) || + is.null(colnames(out)) || + nrow(out) != ncol(out)) { stop("The function supplied to the `method` argument did not return a square matrix or data.frame with row.names and colnames.") } if (easycorrelation) { out <- datasummary_correlation_format( - out, - fmt = fmt, - diagonal = "1", - upper_triangle = ".", - stars = stars) + out, + fmt = fmt, + diagonal = "1", + upper_triangle = ".", + stars = stars) } else if (is.character(method)) { if (method == "pearspear") { out <- datasummary_correlation_format( @@ -219,18 +220,18 @@ datasummary_correlation <- function(data, out <- datasummary_correlation_format( out, fmt = fmt) - } + } col_names <- colnames(out) out <- cbind(rowname = row.names(out), out) - colnames(out) <- c(' ', col_names) + colnames(out) <- c(" ", col_names) if (is.null(align)) { - ncols <- ncol(out) - if (!is.null(add_columns)) { - ncols <- ncols + ncol(add_columns) - } - align <- paste0('l', strrep('r', ncols - 1)) + ncols <- ncol(out) + if (!is.null(add_columns)) { + ncols <- ncols + ncol(add_columns) + } + align <- paste0("l", strrep("r", ncols - 1)) } # labelled data @@ -254,16 +255,15 @@ datasummary_correlation <- function(data, # invisible return if (!is.null(output_file) || - output == "jupyter" || - (output == "default" && settings_equal("output_default", "jupyter"))) { + output == "jupyter" || + (output == "default" && settings_equal("output_default", "jupyter"))) { settings_rm() return(invisible(out)) - # visible return + # visible return } else { settings_rm() return(out) } - } correlation_pearspear <- function(x) { @@ -313,13 +313,12 @@ correlation_pearspear <- function(x) { #' #' datasummary_correlation(dat, method = cor_fun) datasummary_correlation_format <- function( - x, - fmt, - leading_zero = FALSE, - diagonal = NULL, - upper_triangle = NULL, - stars = FALSE) { - + x, + fmt, + leading_zero = FALSE, + diagonal = NULL, + upper_triangle = NULL, + stars = FALSE) { # sanity checkmate::assert_character(diagonal, len = 1, null.ok = TRUE) checkmate::assert_character(upper_triangle, len = 1, null.ok = TRUE) @@ -333,7 +332,7 @@ datasummary_correlation_format <- function( fmt <- sanitize_fmt(fmt) out[[i]] <- fmt(out[[i]]) if (leading_zero == FALSE) { - out[[i]] <- gsub('0\\.', '\\.', out[[i]]) + out[[i]] <- gsub("0\\.", "\\.", out[[i]]) } } diff --git a/R/datasummary_crosstab.R b/R/datasummary_crosstab.R index 2e5ba1a47..aa89ad48a 100644 --- a/R/datasummary_crosstab.R +++ b/R/datasummary_crosstab.R @@ -4,7 +4,7 @@ #' percentages for categorical variables. See the Details section for a #' description of the internal design. For more complex cross tabulations, use #' \link{datasummary} directly. See the Details and Examples sections below, -#' and the vignettes on the `modelsummary` website: +#' and the vignettes on the `modelsummary` website: #' * https://modelsummary.com/ #' * https://modelsummary.com/articles/datasummary.html #' @@ -33,12 +33,13 @@ #' Finally, the `formula` and `statistic` formulas are combined into a single #' formula which is fed directly to the `datasummary` function to produce the #' table. +#' @template kableExtra2tinytable #' @template citation #' @template options #' @section Examples: #' ```{r, eval = FALSE} #' library(modelsummary) -#' +#' #' # crosstab of two variables, showing counts, row percentages, and row/column totals #' datasummary_crosstab(cyl ~ gear, data = mtcars) #' @@ -48,7 +49,7 @@ #' # crosstab of three variables #' datasummary_crosstab(am * cyl ~ gear, data = mtcars) #' -#' # crosstab with two variables and column percentages +#' # crosstab with two variables and column percentages #' datasummary_crosstab(am ~ gear, statistic = ~ Percent("col"), data = mtcars) #' ``` #' @@ -58,7 +59,7 @@ datasummary_crosstab <- function(formula, statistic = 1 ~ 1 + N + Percent("row"), data, - output = 'default', + output = "default", fmt = 1, title = NULL, notes = NULL, @@ -68,34 +69,33 @@ datasummary_crosstab <- function(formula, sparse_header = TRUE, escape = TRUE, ...) { - - ## settings - settings_init(settings = list( - "function_called" = "datasummary_crosstab" - )) + ## settings + settings_init(settings = list( + "function_called" = "datasummary_crosstab" + )) - # argument checking - tmp <- sanitize_output(output) # before sanitize_escape - output_format <- tmp$output_format - output_factory <- tmp$output_factory - output_file <- tmp$output_file - sanitize_escape(escape) # after sanitize_output + # argument checking + tmp <- sanitize_output(output) # before sanitize_escape + output_format <- tmp$output_format + output_factory <- tmp$output_factory + output_file <- tmp$output_file + sanitize_escape(escape) # after sanitize_output - checkmate::assert_formula(formula) - checkmate::assert_formula(statistic, null.ok = TRUE) - checkmate::assert_data_frame(data, min.rows = 1, min.cols = 1) + checkmate::assert_formula(formula) + checkmate::assert_formula(statistic, null.ok = TRUE) + checkmate::assert_data_frame(data, min.rows = 1, min.cols = 1) - # `formula` may not contain + - formula_str <- deparse(formula, width.cutoff = 500) + # `formula` may not contain + + formula_str <- deparse(formula, width.cutoff = 500) - if (grepl("+", formula_str, fixed = TRUE)) { - stop("The `formula` argument of the `datasummary_crosstab` function may not contain variables connected by +, only interactions with * are allowed. To produce more complex tables, consider using the datasummary() function.", call. = FALSE) - } + if (grepl("+", formula_str, fixed = TRUE)) { + stop("The `formula` argument of the `datasummary_crosstab` function may not contain variables connected by +, only interactions with * are allowed. To produce more complex tables, consider using the datasummary() function.", call. = FALSE) + } - if (isTRUE(grepl("=|Heading", formula_str))) { - msg <- -"The `formula` argument of the `datasummary_crosstab` function does not support the `=` sign or the `Heading()` function. You can rename variables in the data frame before calling `datasummary_crosstab` and use backticks to enclose variable names with spaces. For example: + if (isTRUE(grepl("=|Heading", formula_str))) { + msg <- + "The `formula` argument of the `datasummary_crosstab` function does not support the `=` sign or the `Heading()` function. You can rename variables in the data frame before calling `datasummary_crosstab` and use backticks to enclose variable names with spaces. For example: dat <- mtcars dat$`# of Cylinders` <- dat$cyl @@ -103,94 +103,96 @@ datasummary_crosstab(`# of Cylinders` ~ am * gear, data = dat) Note that the `datasummary()` function supports the `=` sign and the `Heading()` function to rename variables. If you would like to contribute code to support those in `datasummary_crosstab`, please visit the `modelsummary` development website: https://github.com/vincentarelbundock/modelsummary " - stop(msg, call. = FALSE) + stop(msg, call. = FALSE) + } + + # `formula` must be length 3 + if (length(formula) != 3) { + stop("`formula` needs to be a two-sided formula, e.g. var1 ~ var2. To produce more complex tables, consider using the datasummary() function.", call. = FALSE) + } + + # check statistic formula + if (!is.null(statistic)) { + lhs_statistic <- ifelse(length(statistic) == 2, "", deparse(statistic[[2]])) + if (!(lhs_statistic %in% c("", ".", "1"))) { + stop("The left-hand side of `statistic` must either be empty of 1. To produce more complex tables, consider using the datasummary() function.") } - - # `formula` must be length 3 - if (length(formula) != 3) { - stop("`formula` needs to be a two-sided formula, e.g. var1 ~ var2. To produce more complex tables, consider using the datasummary() function.", call. = FALSE) + rhs_statistic <- utils::tail(as.character(statistic), 1) + if (grepl("*", rhs_statistic, fixed = TRUE)) { + stop("`statistic` may not contain interactions. To produce more complex tables, consider using the datasummary() function.") } - - # check statistic formula - if (!is.null(statistic)) { - lhs_statistic <- ifelse(length(statistic) == 2, "", deparse(statistic[[2]])) - if (!(lhs_statistic %in% c("", ".", "1"))) { - stop("The left-hand side of `statistic` must either be empty of 1. To produce more complex tables, consider using the datasummary() function.") - } - rhs_statistic <- utils::tail(as.character(statistic), 1) - if (grepl("*", rhs_statistic, fixed = TRUE)) { - stop("`statistic` may not contain interactions. To produce more complex tables, consider using the datasummary() function.") - } - statistic_terms <- stats::terms(statistic) - allowed <- c("N", "Percent()", 'Percent("row")', 'Percent("col")') - if (!all(labels(statistic_terms) %in% allowed)) { - stop("The right-hand side of `statistic` may only contain 1, N, Percent(), Percent('row'), or Percent('col').To produce more complex tables, consider using the datasummary() function.") - } - - # find out if row/column totals should be included - total_row <- ifelse(lhs_statistic == "1", " + 1", "") - rhs <- unlist(strsplit(rhs_statistic, "+", fixed = TRUE)) - total_col <- ifelse("1" %in% trimws(rhs), " + 1", "") - - # adjust labels for % - labels <- labels(statistic_terms) - labels[labels == 'Percent()'] <- 'Heading("%")*Percent()' - labels[labels == 'Percent("row")'] <- 'Heading("% row")*Percent("row")' - labels[labels == 'Percent("col")'] <- 'Heading("% col")*Percent("col")' - } - - # treat all variables as Factors - ## lhs_formula <- paste0("Factor(", all.vars(formula[[2]]), ")") - ## rhs_formula <- paste0("Factor(", all.vars(formula[[3]]), ")") - lhs_formula <- paste0(all.vars(formula[[2]])) - rhs_formula <- paste0(all.vars(formula[[3]])) - - # wrap variable names in backticks if they include spaces - idx <- grepl("\\s", lhs_formula) - lhs_formula[idx] <- sprintf("`%s`", lhs_formula[idx]) - idx <- grepl("\\s", rhs_formula) - rhs_formula[idx] <- sprintf("`%s`", rhs_formula[idx]) - - lhs_formula <- ifelse( - sapply(lhs_formula, function(x) !is.factor(data[[x]])), - sprintf("Factor(%s)", lhs_formula), - lhs_formula) - - rhs_formula <- ifelse( - sapply(rhs_formula, function(x) !is.factor(data[[x]])), - sprintf("Factor(%s)", rhs_formula), - rhs_formula) - - if (is.null(statistic)) { - d_formula <- sprintf("%s ~ %s", - paste(lhs_formula, collapse = " * "), - paste(rhs_formula, collapse = " * ")) - } else { - d_formula <- sprintf("(%s%s) * (%s) ~ %s%s", - paste(lhs_formula, collapse = " * "), total_row, - paste(labels, collapse = " + "), - paste(rhs_formula, collapse = " * "), total_col) - } - - out <- datasummary(formula = stats::as.formula(d_formula), - data = data, - output = output, - fmt = fmt, - title = title, - notes = notes, - align = align, - add_columns = add_columns, - add_rows = add_rows, - sparse_header = sparse_header, - escape = escape, - ...) - - if (!is.null(output_file)) { - settings_rm() - return(invisible(out)) - } else { - settings_rm() - return(out) + statistic_terms <- stats::terms(statistic) + allowed <- c("N", "Percent()", 'Percent("row")', 'Percent("col")') + if (!all(labels(statistic_terms) %in% allowed)) { + stop("The right-hand side of `statistic` may only contain 1, N, Percent(), Percent('row'), or Percent('col').To produce more complex tables, consider using the datasummary() function.") } + # find out if row/column totals should be included + total_row <- ifelse(lhs_statistic == "1", " + 1", "") + rhs <- unlist(strsplit(rhs_statistic, "+", fixed = TRUE)) + total_col <- ifelse("1" %in% trimws(rhs), " + 1", "") + + # adjust labels for % + labels <- labels(statistic_terms) + labels[labels == "Percent()"] <- 'Heading("%")*Percent()' + labels[labels == 'Percent("row")'] <- 'Heading("% row")*Percent("row")' + labels[labels == 'Percent("col")'] <- 'Heading("% col")*Percent("col")' + } + + # treat all variables as Factors + ## lhs_formula <- paste0("Factor(", all.vars(formula[[2]]), ")") + ## rhs_formula <- paste0("Factor(", all.vars(formula[[3]]), ")") + lhs_formula <- paste0(all.vars(formula[[2]])) + rhs_formula <- paste0(all.vars(formula[[3]])) + + # wrap variable names in backticks if they include spaces + idx <- grepl("\\s", lhs_formula) + lhs_formula[idx] <- sprintf("`%s`", lhs_formula[idx]) + idx <- grepl("\\s", rhs_formula) + rhs_formula[idx] <- sprintf("`%s`", rhs_formula[idx]) + + lhs_formula <- ifelse( + sapply(lhs_formula, function(x) !is.factor(data[[x]])), + sprintf("Factor(%s)", lhs_formula), + lhs_formula) + + rhs_formula <- ifelse( + sapply(rhs_formula, function(x) !is.factor(data[[x]])), + sprintf("Factor(%s)", rhs_formula), + rhs_formula) + + if (is.null(statistic)) { + d_formula <- sprintf( + "%s ~ %s", + paste(lhs_formula, collapse = " * "), + paste(rhs_formula, collapse = " * ")) + } else { + d_formula <- sprintf( + "(%s%s) * (%s) ~ %s%s", + paste(lhs_formula, collapse = " * "), total_row, + paste(labels, collapse = " + "), + paste(rhs_formula, collapse = " * "), total_col) + } + + out <- datasummary( + formula = stats::as.formula(d_formula), + data = data, + output = output, + fmt = fmt, + title = title, + notes = notes, + align = align, + add_columns = add_columns, + add_rows = add_rows, + sparse_header = sparse_header, + escape = escape, + ...) + + if (!is.null(output_file)) { + settings_rm() + return(invisible(out)) + } else { + settings_rm() + return(out) + } } diff --git a/R/datasummary_df.R b/R/datasummary_df.R index d8893ca76..26d3aa276 100644 --- a/R/datasummary_df.R +++ b/R/datasummary_df.R @@ -3,6 +3,7 @@ #' @inheritParams datasummary #' @inheritParams modelsummary #' @param hrule position of horizontal rules (integer vector) +#' @template kableExtra2tinytable #' @template citation #' @export datasummary_df <- function(data, @@ -16,7 +17,6 @@ datasummary_df <- function(data, add_columns = NULL, escape = TRUE, ...) { - settings_init(settings = list("function_called" = "datasummary_df")) tmp <- sanitize_output(output) # before sanitize_escape @@ -34,20 +34,19 @@ datasummary_df <- function(data, } out <- factory(data, - align = align, - hrule = hrule, - notes = notes, - output = output, - title = title, - escape = escape, - add_rows = add_rows, - add_columns = add_columns, - output_factory = output_factory, - output_format = output_format, - output_file = output_file, - ...) + align = align, + hrule = hrule, + notes = notes, + output = output, + title = title, + escape = escape, + add_rows = add_rows, + add_columns = add_columns, + output_factory = output_factory, + output_format = output_format, + output_file = output_file, + ...) settings_rm() return(out) - } diff --git a/R/datasummary_skim.R b/R/datasummary_skim.R index 86bcd5d1d..5887b4a60 100644 --- a/R/datasummary_skim.R +++ b/R/datasummary_skim.R @@ -2,7 +2,7 @@ #' #' This function was inspired by the excellent `skimr` package for R. #' See the Details and Examples sections below, and the vignettes on the -#' `modelsummary` website: +#' `modelsummary` website: #' * https://modelsummary.com/ #' * https://modelsummary.com/articles/datasummary.html #' @@ -11,8 +11,9 @@ #' @import data.table #' @param type String. Variables to summarize: "all", "numeric", "categorical", "dataset" #' @param by Character vector of grouping variables to compute statistics over. -#' @param fun_numeric Named list of funtions to apply to each column of `data`. If `fun_numeric` includes "Histogram" or "Density", inline plots are inserted. +#' @param fun_numeric Named list of funtions to apply to each column of `data`. If `fun_numeric` includes "Histogram" or "Density", inline plots are inserted. #' +#' @template kableExtra2tinytable #' @template citation #' @template options #' @examplesIf FALSE @@ -24,25 +25,25 @@ #' #' @export datasummary_skim <- function(data, - output = 'default', - type = 'all', - fmt = 1, - title = NULL, - notes = NULL, - align = NULL, + output = "default", + type = "all", + fmt = 1, + title = NULL, + notes = NULL, + align = NULL, escape = TRUE, by = NULL, - fun_numeric = list("Unique" = NUnique, - "Missing Pct." = PercentMissing, - "Mean" = Mean, - "SD" = SD, - "Min" = Min, - "Median" = Median, - "Max" = Max, - "Histogram" = function(x) ""), + fun_numeric = list( + "Unique" = NUnique, + "Missing Pct." = PercentMissing, + "Mean" = Mean, + "SD" = SD, + "Min" = Min, + "Median" = Median, + "Max" = Max, + "Histogram" = function(x) ""), ...) { - - ## settings + ## settings settings_init(settings = list("function_called" = "datasummary_skim")) tmp <- sanitize_output(output) # before sanitize_escape output_format <- tmp$output_format @@ -83,16 +84,18 @@ datasummary_skim <- function(data, } if (type == "all") { - a <- tryCatch(datasummary_skim_numeric(data, - output = "tinytable", fmt = fmt, by = by, - title = title, notes = notes, align = align, - escape = FALSE, fun_numeric = fun_numeric, ...), - error = function(e) e$message) - b <- tryCatch(datasummary_skim_categorical(data, - output = "tinytable", fmt = fmt, - title = title, notes = notes, align = align, - escape = FALSE, ...), - error = function(e) e$message) + a <- tryCatch( + datasummary_skim_numeric(data, + output = "tinytable", fmt = fmt, by = by, + title = title, notes = notes, align = align, + escape = FALSE, fun_numeric = fun_numeric, ...), + error = function(e) e$message) + b <- tryCatch( + datasummary_skim_categorical(data, + output = "tinytable", fmt = fmt, + title = title, notes = notes, align = align, + escape = FALSE, ...), + error = function(e) e$message) sanitize_output(output) @@ -103,7 +106,7 @@ datasummary_skim <- function(data, out <- tinytable::format_tt(out, replace = "") out <- tinytable::style_tt(out, i = nrow(a) + 1, line = "t", line_size = .3) if (identical(output_format, "html")) { - out <- tinytable::style_tt(out, i = nrow(a) + 1, bold = TRUE, line = "bt", line_color = "#d3d8dc") + out <- tinytable::style_tt(out, i = nrow(a) + 1, bold = TRUE, line = "bt", line_color = "#d3d8dc") } } else if (!inherits(a, "tinytable") && !inherits(b, "tinytable")) { insight::format_error(a, b) @@ -123,7 +126,6 @@ datasummary_skim <- function(data, } out <- tinytable::format_tt(out, escape = escape) - } else if (type == "numeric") { out <- datasummary_skim_numeric(data, output = output, fmt = fmt, by = by, @@ -132,14 +134,12 @@ datasummary_skim <- function(data, sanitize_output(output) data_list <- attr(out, "data_list") - } else if (type == "categorical") { out <- datasummary_skim_categorical(data, output = output, fmt = fmt, title = title, notes = notes, align = align, escape = escape, ...) sanitize_output(output) - } else if (type == "dataset") { out <- datasummary_skim_dataset(data, output = output, title = title, @@ -168,23 +168,19 @@ datasummary_skim <- function(data, settings_rm() return(out) } - } #' Internal function to skim whole datasets #' #' @noRd datasummary_skim_dataset <- function( - data, - output, - title, - notes, - align, - escape, - ...) { - - - + data, + output, + title, + notes, + align, + escape, + ...) { is.binary <- function(x) { tryCatch(length(unique(stats::na.omit(x))) == 2, error = function(e) FALSE, silent = TRUE) } @@ -213,7 +209,6 @@ datasummary_skim_dataset <- function( ...) return(out) - } @@ -230,16 +225,15 @@ datasummary_skim_numeric <- function(data, by = NULL, fun_numeric = NULL, ...) { - # subset of numeric variables idx <- sapply(data, is.numeric) idx[colnames(data) %in% by] <- TRUE - if (!any(idx)) insight::format_error('data contains no numeric variable.') + if (!any(idx)) insight::format_error("data contains no numeric variable.") dat_new <- data[, idx, drop = FALSE] # subset of non-NA variables idx <- sapply(dat_new, function(x) !all(is.na(x))) - if (!any(idx)) insight::format_error('all numeric variables are completely missing.') + if (!any(idx)) insight::format_error("all numeric variables are completely missing.") dat <- dat_new[, idx, drop = FALSE] # too large @@ -252,18 +246,18 @@ datasummary_skim_numeric <- function(data, dat <- data.table::as.data.table(dat) funcs <- list( - "Variable" = function(x) "", - "Internal Data List" = function(x) list(x) + "Variable" = function(x) "", + "Internal Data List" = function(x) list(x) ) funcs <- c(funcs, fun_numeric) # Compute rows <- list() for (v in cols) { - tmp <- dat[, lapply(funcs, function(funny) funny(variable)), - by = by, - env = list("variable" = v)][ - , Variable := v] + tmp <- dat[, lapply(funcs, function(funny) funny(variable)), + by = by, + env = list("variable" = v)][ + , Variable := v] for (i in seq_along(tmp)) { class(tmp[[i]]) <- setdiff(class(tmp[[i]]), c("haven_labelled", "vctrs_vctr")) } @@ -280,7 +274,7 @@ datasummary_skim_numeric <- function(data, rows[Variable == col, Variable := lab] } } - + rows[, Variable := dedup(Variable)] rows[, `Internal Data List` := NULL] idx <- unique(c("Variable", by, colnames(rows))) @@ -288,8 +282,8 @@ datasummary_skim_numeric <- function(data, data.table::setnames(rows, old = "Variable", new = " ") out <- datasummary_df(rows, - fmt = fmt, - output = output) + fmt = fmt, + output = output) attr(out, "data_list") <- data_list @@ -303,15 +297,14 @@ datasummary_skim_numeric <- function(data, #' #' @noRd datasummary_skim_categorical <- function( - data, - output, - fmt, - title, - notes, - align, - escape, - ...) { - + data, + output, + fmt, + title, + notes, + align, + escape, + ...) { dat_new <- data # pad colnames in case one is named Min, Max, Mean, or other function name @@ -322,7 +315,6 @@ datasummary_skim_categorical <- function( for (n in colnames(dat_new)) { - # completely missing if (all(is.na(dat_new[[n]]))) { dat_new[[n]] <- NULL @@ -330,9 +322,8 @@ datasummary_skim_categorical <- function( } if (is.logical(dat_new[[n]]) | - is.character(dat_new[[n]]) | - is.factor(dat_new[[n]])) { - + is.character(dat_new[[n]]) | + is.factor(dat_new[[n]])) { # convert to factor and keep NAs as distinct level if (is.logical(dat_new[[n]]) | is.character(dat_new[[n]])) { dat_new[[n]] <- factor(dat_new[[n]], exclude = NULL) @@ -346,22 +337,21 @@ datasummary_skim_categorical <- function( ## factors with too many levels if (is.factor(dat_new[[n]])) { - if (length(levels(dat_new[[n]])) > 50) { - dat_new[[n]] <- NULL - drop_too_many_levels <- c(drop_too_many_levels, n) - } + if (length(levels(dat_new[[n]])) > 50) { + dat_new[[n]] <- NULL + drop_too_many_levels <- c(drop_too_many_levels, n) + } } - # discard non-factors + # discard non-factors } else { dat_new[[n]] <- NULL } - } # too small if (ncol(dat_new) == 0) { - stop('data contains no logical, character, or factor variable.') + stop("data contains no logical, character, or factor variable.") } # too large @@ -370,18 +360,18 @@ datasummary_skim_categorical <- function( } if (!is.null(drop_too_many_levels)) { - warning(sprintf("These variables were omitted because they include more than 50 levels: %s.", paste(drop_too_many_levels, collapse=", ")), - call. = FALSE) + warning(sprintf("These variables were omitted because they include more than 50 levels: %s.", paste(drop_too_many_levels, collapse = ", ")), + call. = FALSE) } if (!is.null(drop_entirely_na)) { - warning(sprintf("These variables were omitted because they are entirely missing: %s.", paste(drop_entirely_na, collapse=", ")), - call. = FALSE) + warning(sprintf("These variables were omitted because they are entirely missing: %s.", paste(drop_entirely_na, collapse = ", ")), + call. = FALSE) } pctformat <- sanitize_fmt(fmt) f <- All(dat_new, numeric = FALSE, factor = TRUE, logical = TRUE, character = TRUE) ~ - (N = 1) * Format() + (`%` = Percent()) * Format(pctformat()) + (N = 1) * Format() + (`%` = Percent()) * Format(pctformat()) datasummary( formula = f, @@ -390,13 +380,14 @@ datasummary_skim_categorical <- function( title = title, align = align, notes = notes) - } dedup <- function(x) { - if (length(x) < 2) return(x) + if (length(x) < 2) { + return(x) + } for (i in length(x):2) { if (x[i] == x[i - 1]) { x[i] <- NA diff --git a/R/modelsummary.R b/R/modelsummary.R index 53d59d7ae..21e57d32d 100644 --- a/R/modelsummary.R +++ b/R/modelsummary.R @@ -1,10 +1,11 @@ # https://stackoverflow.com/questions/9439256/how-can-i-handle-r-cmd-check-no-visible-binding-for-global-variable-notes-when#comment20826625_12429344 # 2012 wickham says "globalVariables is a hideous hack and I will never use it" # 2014 wickham updates his own answer with globalVariables as one of "two solutions" -globalVariables(c('.', 'term', 'part', 'estimate', 'conf.high', 'conf.low', -'value', 'p.value', 'std.error', 'statistic', 'stars_note', 'logLik', -'formatBicLL', 'section', 'position', 'where', 'ticks', 'statistic1', 'model', -'tmp_grp', 'condition_variable', 'conf_int', 'conf_level', '..idx', 'Internal Data List', 'Variable', 'variable')) +globalVariables(c( + ".", "term", "part", "estimate", "conf.high", "conf.low", + "value", "p.value", "std.error", "statistic", "stars_note", "logLik", + "formatBicLL", "section", "position", "where", "ticks", "statistic1", "model", + "tmp_grp", "condition_variable", "conf_int", "conf_level", "..idx", "Internal Data List", "Variable", "variable")) @@ -22,12 +23,10 @@ globalVariables(c('.', 'term', 'part', 'estimate', 'conf.high', 'conf.low', #' * [The `modelsummary` Vignette includes dozens of examples of tables with extensive customizations.](https://modelsummary.com/articles/modelsummary.html) #' * [The Appearance Vignette shows how to modify the look of tables.](https://modelsummary.com/articles/appearance.html) #' +#' @template kableExtra2tinytable #' @template citation -#' #' @template modelsummary_details -#' #' @template options -#' #' @template modelsummary_parallel #' #' @param models a model, (named) list of models, or nested list of models. @@ -36,7 +35,7 @@ globalVariables(c('.', 'term', 'part', 'estimate', 'conf.high', 'conf.low', #' - Models are labelled automatically. The default label style can be altered by setting a global option. See below. #' * Named list of models: `modelsummary(list("A"=model1, "B"=model2))` #' - Models are labelled using the list names. -#' * Nested list of models: +#' * Nested list of models: #' - When using the `shape` argument with "rbind", "rcollapse", or "cbind" values, `models` can be a nested list of models to display "panels" or "stacks" of regression models. See the `shape` argument documentation and examples below. #' @param output filename or object type (character string) #' * Supported filename extensions: .docx, .html, .tex, .md, .txt, .csv, .xlsx, .png, .jpg @@ -73,8 +72,8 @@ globalVariables(c('.', 'term', 'part', 'estimate', 'conf.high', 'conf.low', #' - `"{exp(estimate) * std.error}"` #' - Numbers are automatically rounded and converted to strings. To apply functions to their numeric values, as in the last `glue` example, users must set `fmt=NULL`. #' - Parentheses are added automatically unless the string includes `glue` curly braces `{}`. -#' * Notes: -#' - The names of the `statistic` are used a column names when using the `shape` argument to display statistics as columns: +#' * Notes: +#' - The names of the `statistic` are used a column names when using the `shape` argument to display statistics as columns: #' - `statistic=c("p"="p.value", "["="conf.low", "]"="conf.high")` #' - Some statistics are not supported for all models. See column names in `get_estimates(model)`, and visit the website to learn how to add custom statistics. #' @param vcov robust standard errors and other manual statistics. The `vcov` @@ -182,91 +181,95 @@ globalVariables(c('.', 'term', 'part', 'estimate', 'conf.high', 'conf.low', #' + [tinytable::tt], [kableExtra::kbl] or [gt::gt] draw tables, depending on the value of the `output` argument. For example, by default `modelsummary` creates tables with [tinytable::tt], which accepts a `width` and `theme` arguments. #' @return a regression table in a format determined by the `output` argument. #' @importFrom generics glance tidy -#' @examplesIf isTRUE(Sys.getenv("R_NOT_CRAN") == 'true') +#' @examplesIf isTRUE(Sys.getenv("R_NOT_CRAN") == "true") #' # The `modelsummary` website includes \emph{many} examples and tutorials: #' # https://modelsummary.com #' #' library(modelsummary) -#' +#' #' # load data and estimate models #' utils::data(trees) #' models <- list() -#' models[['Bivariate']] <- lm(Girth ~ Height, data = trees) -#' models[['Multivariate']] <- lm(Girth ~ Height + Volume, data = trees) -#' +#' models[["Bivariate"]] <- lm(Girth ~ Height, data = trees) +#' models[["Multivariate"]] <- lm(Girth ~ Height + Volume, data = trees) +#' #' # simple table #' modelsummary(models) -#' +#' #' # statistic #' modelsummary(models, statistic = NULL) -#' -#' modelsummary(models, statistic = 'p.value') -#' -#' modelsummary(models, statistic = 'statistic') -#' -#' modelsummary(models, statistic = 'conf.int', conf_level = 0.99) -#' -#' modelsummary(models, statistic = c("t = {statistic}", -#' "se = {std.error}", -#' "conf.int")) -#' +#' +#' modelsummary(models, statistic = "p.value") +#' +#' modelsummary(models, statistic = "statistic") +#' +#' modelsummary(models, statistic = "conf.int", conf_level = 0.99) +#' +#' modelsummary(models, statistic = c( +#' "t = {statistic}", +#' "se = {std.error}", +#' "conf.int")) +#' #' # estimate #' modelsummary(models, #' statistic = NULL, #' estimate = "{estimate} [{conf.low}, {conf.high}]") -#' +#' #' modelsummary(models, -#' estimate = c("{estimate}{stars}", -#' "{estimate} ({std.error})")) -#' +#' estimate = c( +#' "{estimate}{stars}", +#' "{estimate} ({std.error})")) +#' #' # vcov #' modelsummary(models, vcov = "robust") -#' +#' #' modelsummary(models, vcov = list("classical", "stata")) -#' +#' #' modelsummary(models, vcov = sandwich::vcovHC) -#' +#' #' modelsummary(models, #' vcov = list(stats::vcov, sandwich::vcovHC)) -#' +#' #' modelsummary(models, -#' vcov = list(c("(Intercept)"="", "Height"="!"), -#' c("(Intercept)"="", "Height"="!", "Volume"="!!"))) -#' +#' vcov = list( +#' c("(Intercept)" = "", "Height" = "!"), +#' c("(Intercept)" = "", "Height" = "!", "Volume" = "!!"))) +#' #' # vcov with custom names #' modelsummary( #' models, -#' vcov = list("Stata Corp" = "stata", -#' "Newey Lewis & the News" = "NeweyWest")) -#' +#' vcov = list( +#' "Stata Corp" = "stata", +#' "Newey Lewis & the News" = "NeweyWest")) +#' #' # fmt #' mod <- lm(mpg ~ hp + drat + qsec, data = mtcars) -#' +#' #' modelsummary(mod, fmt = 3) -#' +#' #' modelsummary(mod, fmt = fmt_significant(3)) -#' +#' #' modelsummary(mod, fmt = NULL) -#' +#' #' modelsummary(mod, fmt = fmt_decimal(4)) -#' +#' #' modelsummary(mod, fmt = fmt_sprintf("%.5f")) -#' +#' #' modelsummary(mod, fmt = fmt_statistic(estimate = 4, conf.int = 1), statistic = "conf.int") -#' +#' #' modelsummary(mod, fmt = fmt_term(hp = 4, drat = 1, default = 2)) -#' +#' #' m <- lm(mpg ~ I(hp * 1000) + drat, data = mtcars) #' f <- function(x) format(x, digits = 3, nsmall = 2, scientific = FALSE, trim = TRUE) #' modelsummary(m, fmt = f, gof_map = NA) -#' +#' #' # coef_rename -#' modelsummary(models, coef_rename = c('Volume' = 'Large', 'Height' = 'Tall')) -#' +#' modelsummary(models, coef_rename = c("Volume" = "Large", "Height" = "Tall")) +#' #' modelsummary(models, coef_rename = toupper) -#' +#' #' modelsummary(models, coef_rename = coef_rename) -#' +#' #' # coef_rename = TRUE for variable labels #' datlab <- mtcars #' datlab$cyl <- factor(datlab$cyl) @@ -274,122 +277,122 @@ globalVariables(c('.', 'term', 'part', 'estimate', 'conf.high', 'conf.low', #' attr(datlab$cyl, "label") <- "Cylinders" #' modlab <- lm(mpg ~ hp * drat + cyl, data = datlab) #' modelsummary(modlab, coef_rename = TRUE) -#' +#' #' # coef_rename: unnamed vector of length equal to the number of terms in the final table #' m <- lm(hp ~ mpg + factor(cyl), data = mtcars) #' modelsummary(m, coef_omit = -(3:4), coef_rename = c("Cyl 6", "Cyl 8")) -#' +#' #' # coef_map -#' modelsummary(models, coef_map = c('Volume' = 'Large', 'Height' = 'Tall')) -#' -#' modelsummary(models, coef_map = c('Volume', 'Height')) -#' +#' modelsummary(models, coef_map = c("Volume" = "Large", "Height" = "Tall")) +#' +#' modelsummary(models, coef_map = c("Volume", "Height")) +#' #' # coef_omit: omit the first and second coefficients #' modelsummary(models, coef_omit = 1:2) -#' +#' #' # coef_omit: omit coefficients matching one substring #' modelsummary(models, coef_omit = "ei", gof_omit = ".*") -#' +#' #' # coef_omit: omit a specific coefficient #' modelsummary(models, coef_omit = "^Volume$", gof_omit = ".*") -#' +#' #' # coef_omit: omit coefficients matching either one of two substring -#' #modelsummary(models, coef_omit = "ei|rc", gof_omit = ".*") -#' +#' # modelsummary(models, coef_omit = "ei|rc", gof_omit = ".*") +#' #' # coef_omit: keep coefficients starting with a substring (using a negative lookahead) -#' #modelsummary(models, coef_omit = "^(?!Vol)", gof_omit = ".*") -#' +#' # modelsummary(models, coef_omit = "^(?!Vol)", gof_omit = ".*") +#' #' # coef_omit: keep coefficients matching a substring #' modelsummary(models, coef_omit = "^(?!.*ei|.*pt)", gof_omit = ".*") -#' +#' #' # shape: multinomial model #' library(nnet) -#' multi <- multinom(factor(cyl) ~ mpg + hp, data = mtcars, trace = FALSE) -#' +#' multi <- multinom(factor(cyl) ~ mpg + hp, data = mtcars, trace = FALSE) +#' #' # shape: term names and group ids in rows, models in columns #' modelsummary(multi, shape = response ~ model) -#' +#' #' # shape: term names and group ids in rows in a single column -#' modelsummary(multi, shape = term : response ~ model) -#' +#' modelsummary(multi, shape = term:response ~ model) +#' #' # shape: term names in rows and group ids in columns #' modelsummary(multi, shape = term ~ response:model) -#' +#' #' # shape = "rcollapse" #' panels <- list( -#' "Panel A: MPG" = list( -#' "A" = lm(mpg ~ hp, data = mtcars), -#' "B" = lm(mpg ~ hp + factor(gear), data = mtcars)), -#' "Panel B: Displacement" = list( -#' "A" = lm(disp ~ hp, data = mtcars), -#' "C" = lm(disp ~ hp + factor(gear), data = mtcars)) +#' "Panel A: MPG" = list( +#' "A" = lm(mpg ~ hp, data = mtcars), +#' "B" = lm(mpg ~ hp + factor(gear), data = mtcars)), +#' "Panel B: Displacement" = list( +#' "A" = lm(disp ~ hp, data = mtcars), +#' "C" = lm(disp ~ hp + factor(gear), data = mtcars)) #' ) -#' +#' #' # shape = "cbind" #' modelsummary(panels, shape = "cbind") -#' +#' #' modelsummary( -#' panels, -#' shape = "rbind", -#' gof_map = c("nobs", "r.squared")) -#' +#' panels, +#' shape = "rbind", +#' gof_map = c("nobs", "r.squared")) +#' #' # title -#' modelsummary(models, title = 'This is the title') -#' +#' modelsummary(models, title = "This is the title") +#' #' # title with LaTeX label (for numbering and referencing) -#' modelsummary(models, title = 'This is the title \\label{tab:description}', escape = FALSE) -#' +#' modelsummary(models, title = "This is the title \\label{tab:description}", escape = FALSE) +#' #' # add_rows -#' rows <- tibble::tribble(~term, ~Bivariate, ~Multivariate, -#' 'Empty row', '-', '-', -#' 'Another empty row', '?', '?') -#' attr(rows, 'position') <- c(1, 3) +#' rows <- tibble::tribble( +#' ~term, ~Bivariate, ~Multivariate, +#' "Empty row", "-", "-", +#' "Another empty row", "?", "?") +#' attr(rows, "position") <- c(1, 3) #' modelsummary(models, add_rows = rows) -#' +#' #' # notes -#' modelsummary(models, notes = list('A first note', 'A second note')) -#' +#' modelsummary(models, notes = list("A first note", "A second note")) +#' #' # gof_map: tribble #' library(tibble) #' gm <- tribble( -#' ~raw, ~clean, ~fmt, +#' ~raw, ~clean, ~fmt, #' "r.squared", "R Squared", 5) #' modelsummary(models, gof_map = gm) -#' +#' #' # gof_map: list of lists -#' f <- function(x) format(round(x, 3), big.mark=",") +#' f <- function(x) format(round(x, 3), big.mark = ",") #' gm <- list( #' list("raw" = "nobs", "clean" = "N", "fmt" = f), #' list("raw" = "AIC", "clean" = "aic", "fmt" = f)) #' modelsummary(models, gof_map = gm) -#' +#' #' @export modelsummary <- function( - models, - output = "default", - fmt = 3, - estimate = "estimate", - statistic = "std.error", - vcov = NULL, - conf_level = 0.95, - exponentiate = FALSE, - stars = FALSE, - shape = term + statistic ~ model, - coef_map = NULL, - coef_omit = NULL, - coef_rename = FALSE, - gof_map = NULL, - gof_omit = NULL, - gof_function = NULL, - group_map = NULL, - add_columns = NULL, - add_rows = NULL, - align = NULL, - notes = NULL, - title = NULL, - escape = TRUE, - ...) { - + models, + output = "default", + fmt = 3, + estimate = "estimate", + statistic = "std.error", + vcov = NULL, + conf_level = 0.95, + exponentiate = FALSE, + stars = FALSE, + shape = term + statistic ~ model, + coef_map = NULL, + coef_omit = NULL, + coef_rename = FALSE, + gof_map = NULL, + gof_omit = NULL, + gof_function = NULL, + group_map = NULL, + add_columns = NULL, + add_rows = NULL, + align = NULL, + notes = NULL, + title = NULL, + escape = TRUE, + ...) { # panel summary shape: dispatch to other function checkmate::assert( checkmate::check_formula(shape), @@ -421,7 +424,7 @@ modelsummary <- function( title = title, escape = escape, ...) - return(out) + return(out) } dots <- list(...) @@ -437,7 +440,7 @@ modelsummary <- function( ## sanity functions validate variables/settings ## sanitize functions validate & modify & initialize checkmate::assert_string(gof_omit, null.ok = TRUE) - tmp <- sanitize_output(output) # early + tmp <- sanitize_output(output) # early output_format <- tmp$output_format output_factory <- tmp$output_factory output_file <- tmp$output_file @@ -453,7 +456,7 @@ modelsummary <- function( # other sanity checks sanitize_escape(escape) - sanity_ellipsis(vcov, ...) # before sanitize_vcov + sanity_ellipsis(vcov, ...) # before sanitize_vcov models <- sanitize_models(models, ...) # before sanitize_vcov vcov <- sanitize_vcov(vcov, models, ...) number_of_models <- max(length(models), length(vcov)) @@ -494,7 +497,6 @@ modelsummary <- function( if (grepl("\\(", modelsummary_model_labels)) { model_names <- sprintf("(%s)", model_names) } - } else { model_names <- names(models) } @@ -504,8 +506,8 @@ modelsummary <- function( # insert think white non-breaking space # don't do this now when called from modelsummary_rbind() or there are escape issues if (!settings_equal("function_called", "modelsummary_rbind") && - all(grepl("^\\(\\d+\\)$", model_names)) && - identical(output_format, "kableExtra")) { + all(grepl("^\\(\\d+\\)$", model_names)) && + identical(output_format, "kableExtra")) { model_names <- paste0(" ", model_names) } @@ -514,15 +516,16 @@ modelsummary <- function( ####################### # modelsummary_list # ####################### - msl <- get_list_of_modelsummary_lists(models = models, - conf_level = conf_level, - vcov = vcov, - gof_map = gof_map, # check if we can skip all gof computation - gof_function = gof_function, - shape = shape, - coef_rename = coef_rename, - output_format = output_format, - ...) + msl <- get_list_of_modelsummary_lists( + models = models, + conf_level = conf_level, + vcov = vcov, + gof_map = gof_map, # check if we can skip all gof computation + gof_function = gof_function, + shape = shape, + coef_rename = coef_rename, + output_format = output_format, + ...) names(msl) <- model_names @@ -539,29 +542,28 @@ modelsummary <- function( ############### est <- list() for (i in seq_along(msl)) { - tmp <- format_estimates( - est = msl[[i]]$tidy, - fmt = fmt, - estimate = estimate[[i]], + est = msl[[i]]$tidy, + fmt = fmt, + estimate = estimate[[i]], # enforce single name when multiple estimates in different colums estimate_label = names(estimate)[1], - statistic = statistic, - vcov = vcov[[i]], + statistic = statistic, + vcov = vcov[[i]], conf_level = conf_level, - stars = stars, - shape = shape, + stars = stars, + shape = shape, group_name = shape$group_name, exponentiate = exponentiate[[i]], ...) # before merging to collapse tmp <- map_estimates( - tmp, - coef_rename = coef_rename, - coef_map = coef_map, - coef_omit = coef_omit, - group_map = group_map) + tmp, + coef_rename = coef_rename, + coef_map = coef_map, + coef_omit = coef_omit, + group_map = group_map) colnames(tmp)[match("modelsummary_value", colnames(tmp))] <- model_names[i] @@ -573,8 +575,11 @@ modelsummary <- function( bycols <- c(list(c(shape$group_name, "group", "term", "statistic")), lapply(est, colnames)) bycols <- Reduce(intersect, bycols) - f <- function(x, y) merge(x, y, all = TRUE, sort = FALSE, - by = bycols) + f <- function(x, y) { + merge(x, y, + all = TRUE, sort = FALSE, + by = bycols) + } est <- Reduce(f, est) # warn that `shape` might be needed @@ -607,18 +612,17 @@ modelsummary <- function( # sort rows using factor trick if ("term" %in% colnames(est)) { if (!is.null(coef_map)) { - term_order <- coef_map + term_order <- coef_map } est$term <- factor(est$term, unique(term_order)) if ("group" %in% colnames(est)) { if (!is.null(group_map)) { - est$group <- factor(est$group, group_map) + est$group <- factor(est$group, group_map) } else { - est$group <- factor(est$group, unique(est$group)) + est$group <- factor(est$group, unique(est$group)) } } - } else if ("model" %in% colnames(est)) { est$model <- factor(est$model, model_names) } @@ -696,9 +700,9 @@ modelsummary <- function( for (i in seq_along(msl)) { if (is.data.frame(msl[[i]]$glance)) { gof[[i]] <- format_gof(msl[[i]]$glance, - fmt = fmt, - gof_map = gof_map, - ...) + fmt = fmt, + gof_map = gof_map, + ...) colnames(gof[[i]])[2] <- model_names[i] } else { gof[[i]] <- NULL @@ -717,26 +721,26 @@ modelsummary <- function( ################## # empty cells - tab[is.na(tab)] <- '' + tab[is.na(tab)] <- "" # interaction : becomes × if (is.null(coef_map) && - isFALSE(coef_rename) && - "term" %in% colnames(tab) && - !identical(output_format, "rtf")) { - idx <- tab$part != 'gof' + isFALSE(coef_rename) && + "term" %in% colnames(tab) && + !identical(output_format, "rtf")) { + idx <- tab$part != "gof" # catch for fixest `i()` operator - tab$term <- ifelse(idx, gsub('::', ' = ', tab$term), tab$term) + tab$term <- ifelse(idx, gsub("::", " = ", tab$term), tab$term) # conventional interaction - tab$term <- ifelse(idx, gsub(':', ' \u00d7 ', tab$term), tab$term) + tab$term <- ifelse(idx, gsub(":", " \u00d7 ", tab$term), tab$term) } # measure table - hrule <- match('gof', tab$part) + hrule <- match("gof", tab$part) if (!is.na(hrule) && - !is.null(add_rows) && - !is.null(attr(add_rows, 'position'))) { - hrule <- hrule + sum(attr(add_rows, 'position') < hrule) + !is.null(add_rows) && + !is.null(attr(add_rows, "position"))) { + hrule <- hrule + sum(attr(add_rows, "position") < hrule) } if (is.na(hrule)) { hrule <- NULL @@ -759,7 +763,6 @@ modelsummary <- function( } if (!identical(output_format, "dataframe") && !settings_equal("function_called", "modelsummary_rbind")) { - dups <- c("term", "model", shape$group_name) for (d in dups) { tab <- redundant_labels(tab, d) @@ -770,7 +773,7 @@ modelsummary <- function( # HACK: arbitrary spaces to avoid name conflict - if ("term" %in% colnames(tab)) colnames(tab)[colnames(tab) == "term"] <- " " + if ("term" %in% colnames(tab)) colnames(tab)[colnames(tab) == "term"] <- " " if ("model" %in% colnames(tab)) colnames(tab)[colnames(tab) == "model"] <- " " if ("group" %in% colnames(tab)) colnames(tab)[colnames(tab) == "model"] <- " " } @@ -792,7 +795,7 @@ modelsummary <- function( # align if (is.null(align)) { n_stub <- sum(grepl("^ *$", colnames(tab))) + - sum(colnames(tab) %in% c(" ", shape$group_name)) + sum(colnames(tab) %in% c(" ", shape$group_name)) align <- paste0(strrep("l", n_stub), strrep("c", ncol(tab) - n_stub)) if (isTRUE(checkmate::check_data_frame(add_columns))) { align <- paste0(align, strrep("c", ncol(add_columns))) @@ -825,12 +828,12 @@ modelsummary <- function( ## build table out <- factory( tab, - align = align, - fmt = fmt, - hrule = hrule, - notes = notes, - output = output, - title = title, + align = align, + fmt = fmt, + hrule = hrule, + notes = notes, + output = output, + title = title, add_rows = add_rows, add_columns = add_columns, escape = escape, @@ -847,74 +850,72 @@ modelsummary <- function( if (settings_equal("function_called", "modelsummary_rbind")) { return(out) } else if (!is.null(output_file) || - isTRUE(output == "jupyter") || - (isTRUE(output == "default") && settings_equal("output_default", "jupyter"))) { + isTRUE(output == "jupyter") || + (isTRUE(output == "default") && settings_equal("output_default", "jupyter"))) { settings_rm() return(invisible(out)) - # visible return + # visible return } else { settings_rm() return(out) } - } get_list_of_modelsummary_lists <- function(models, conf_level, vcov, gof_map, gof_function, shape, coef_rename, output_format, ...) { + number_of_models <- max(length(models), length(vcov)) - number_of_models <- max(length(models), length(vcov)) - - inner_loop <- function(i) { - # recycling when 1 model and many vcov - j <- ifelse(length(models) == 1, 1, i) - - if (inherits(models[[j]], "modelsummary_list")) { - out <- list( - tidy = models[[j]][["tidy"]], - glance = models[[j]][["glance"]]) - return(out) - } - - # don't waste time if we are going to exclude all gof anyway - gla <- get_gof(models[[j]], vcov_type = names(vcov)[i], gof_map = gof_map, gof_function = gof_function, ...) - - tid <- get_estimates( - models[[j]], - conf_level = conf_level, - vcov = vcov[[i]], - shape = shape, - coef_rename = coef_rename, - ...) - - out <- list("tidy" = tid, "glance" = gla) - class(out) <- "modelsummary_list" - return(out) + inner_loop <- function(i) { + # recycling when 1 model and many vcov + j <- ifelse(length(models) == 1, 1, i) + + if (inherits(models[[j]], "modelsummary_list")) { + out <- list( + tidy = models[[j]][["tidy"]], + glance = models[[j]][["glance"]]) + return(out) } - # {parallel} - dots <- list(...) - if ("mc.cores" %in% names(dots)) { - out <- parallel::mclapply(seq_len(number_of_models), inner_loop, mc.cores = dots[["mc.cores"]]) + # don't waste time if we are going to exclude all gof anyway + gla <- get_gof(models[[j]], vcov_type = names(vcov)[i], gof_map = gof_map, gof_function = gof_function, ...) + + tid <- get_estimates( + models[[j]], + conf_level = conf_level, + vcov = vcov[[i]], + shape = shape, + coef_rename = coef_rename, + ...) + + out <- list("tidy" = tid, "glance" = gla) + class(out) <- "modelsummary_list" + return(out) + } + + # {parallel} + dots <- list(...) + if ("mc.cores" %in% names(dots)) { + out <- parallel::mclapply(seq_len(number_of_models), inner_loop, mc.cores = dots[["mc.cores"]]) # {future} - } else if (isTRUE(check_dependency("future.apply")) && - future::nbrOfWorkers() > 1 && - number_of_models > 1 && - isTRUE(getOption("modelsummary_future", default = TRUE))) { - # Issue #647: conflict with `furrr`. Very hard to diagnose. - out <- try( - future.apply::future_lapply(seq_len(number_of_models), inner_loop, future.seed = TRUE), - silent = TRUE) - if (inherits(out, "try-error")) { - out <- lapply(seq_len(number_of_models), inner_loop) - } + } else if (isTRUE(check_dependency("future.apply")) && + future::nbrOfWorkers() > 1 && + number_of_models > 1 && + isTRUE(getOption("modelsummary_future", default = TRUE))) { + # Issue #647: conflict with `furrr`. Very hard to diagnose. + out <- try( + future.apply::future_lapply(seq_len(number_of_models), inner_loop, future.seed = TRUE), + silent = TRUE) + if (inherits(out, "try-error")) { + out <- lapply(seq_len(number_of_models), inner_loop) + } # sequential - } else { - out <- lapply(seq_len(number_of_models), inner_loop) - } + } else { + out <- lapply(seq_len(number_of_models), inner_loop) + } - return(out) + return(out) } @@ -940,5 +941,3 @@ redundant_labels <- function(dat, column) { #' @keywords internal #' @export msummary <- modelsummary - - diff --git a/R/zzz.R b/R/zzz.R index e4d864b7e..e73d569b5 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,19 +1,5 @@ -.onAttach <- function(libname, pkgname){ - msg <- insight::format_message( -"`modelsummary` 2.0.0 now uses `tinytable` as its default table-drawing backend. Learn more at: https://vincentarelbundock.github.io/tinytable/", -"", -"Revert to `kableExtra` for one session:", -"", -" options(modelsummary_factory_default = 'kableExtra')", -" options(modelsummary_factory_latex = 'kableExtra')", -" options(modelsummary_factory_html = 'kableExtra')", -"", -"Silence this message forever:", -"", -" config_modelsummary(startup_message = FALSE)", -indent = "" -) +.onAttach <- function(libname, pkgname) { if (isTRUE(config_get("startup_message"))) { - packageStartupMessage(msg) + # packageStartupMessage(msg) } } diff --git a/man-roxygen/kableExtra2tinytable.R b/man-roxygen/kableExtra2tinytable.R new file mode 100644 index 000000000..4e0a2856b --- /dev/null +++ b/man-roxygen/kableExtra2tinytable.R @@ -0,0 +1,10 @@ +#' @section Version 2.0.0, kableExtra, and tinytable: +#' +#' Since version 2.0.0, `modelsummary` uses `tinytable` as its default table-drawing backend. +#' Learn more at: https://vincentarelbundock.github.io/tinytable/", +#' +#' Revert to `kableExtra` for one session: +#' +#' `options(modelsummary_factory_default = 'kableExtra')` +#' `options(modelsummary_factory_latex = 'kableExtra')` +#' `options(modelsummary_factory_html = 'kableExtra')` diff --git a/man/datasummary.Rd b/man/datasummary.Rd index 8493821fb..60563456a 100644 --- a/man/datasummary.Rd +++ b/man/datasummary.Rd @@ -118,6 +118,19 @@ Hierarchical or "nested" column labels are only available for these output formats: tinytable, kableExtra, gt, html, rtf, and LaTeX. When saving tables to other formats, nested labels will be combined to a "flat" header. } +\section{Version 2.0.0, kableExtra, and tinytable}{ + + +Since version 2.0.0, \code{modelsummary} uses \code{tinytable} as its default table-drawing backend. +Learn more at: https://vincentarelbundock.github.io/tinytable/", + +Revert to \code{kableExtra} for one session: + +\code{options(modelsummary_factory_default = 'kableExtra')} +\code{options(modelsummary_factory_latex = 'kableExtra')} +\code{options(modelsummary_factory_html = 'kableExtra')} +} + \section{Global Options}{ diff --git a/man/datasummary_balance.Rd b/man/datasummary_balance.Rd index 6015ce77c..63a7f01a9 100644 --- a/man/datasummary_balance.Rd +++ b/man/datasummary_balance.Rd @@ -118,6 +118,19 @@ below, and the vignettes on the \code{modelsummary} website: \item https://modelsummary.com/articles/datasummary.html } } +\section{Version 2.0.0, kableExtra, and tinytable}{ + + +Since version 2.0.0, \code{modelsummary} uses \code{tinytable} as its default table-drawing backend. +Learn more at: https://vincentarelbundock.github.io/tinytable/", + +Revert to \code{kableExtra} for one session: + +\code{options(modelsummary_factory_default = 'kableExtra')} +\code{options(modelsummary_factory_latex = 'kableExtra')} +\code{options(modelsummary_factory_html = 'kableExtra')} +} + \section{Global Options}{ diff --git a/man/datasummary_correlation.Rd b/man/datasummary_correlation.Rd index a132929ae..68e815e1d 100644 --- a/man/datasummary_correlation.Rd +++ b/man/datasummary_correlation.Rd @@ -107,6 +107,19 @@ Examples sections below, and the vignettes on the \code{modelsummary} website: \item https://modelsummary.com/articles/datasummary.html } } +\section{Version 2.0.0, kableExtra, and tinytable}{ + + +Since version 2.0.0, \code{modelsummary} uses \code{tinytable} as its default table-drawing backend. +Learn more at: https://vincentarelbundock.github.io/tinytable/", + +Revert to \code{kableExtra} for one session: + +\code{options(modelsummary_factory_default = 'kableExtra')} +\code{options(modelsummary_factory_latex = 'kableExtra')} +\code{options(modelsummary_factory_html = 'kableExtra')} +} + \section{Global Options}{ diff --git a/man/datasummary_crosstab.Rd b/man/datasummary_crosstab.Rd index 89d1ba343..264c47f37 100644 --- a/man/datasummary_crosstab.Rd +++ b/man/datasummary_crosstab.Rd @@ -128,6 +128,19 @@ table. Variables in \code{formula} are automatically wrapped in \code{Factor()}. } +\section{Version 2.0.0, kableExtra, and tinytable}{ + + +Since version 2.0.0, \code{modelsummary} uses \code{tinytable} as its default table-drawing backend. +Learn more at: https://vincentarelbundock.github.io/tinytable/", + +Revert to \code{kableExtra} for one session: + +\code{options(modelsummary_factory_default = 'kableExtra')} +\code{options(modelsummary_factory_latex = 'kableExtra')} +\code{options(modelsummary_factory_html = 'kableExtra')} +} + \section{Global Options}{ @@ -239,7 +252,7 @@ datasummary_crosstab(cyl ~ gear, statistic = ~ N, data = mtcars) # crosstab of three variables datasummary_crosstab(am * cyl ~ gear, data = mtcars) -# crosstab with two variables and column percentages +# crosstab with two variables and column percentages datasummary_crosstab(am ~ gear, statistic = ~ Percent("col"), data = mtcars) }\if{html}{\out{}} } diff --git a/man/datasummary_df.Rd b/man/datasummary_df.Rd index e2cbbd022..446e886f6 100644 --- a/man/datasummary_df.Rd +++ b/man/datasummary_df.Rd @@ -84,6 +84,19 @@ affect the behavior of other functions behind the scenes.} \description{ Draw a table from a data.frame } +\section{Version 2.0.0, kableExtra, and tinytable}{ + + +Since version 2.0.0, \code{modelsummary} uses \code{tinytable} as its default table-drawing backend. +Learn more at: https://vincentarelbundock.github.io/tinytable/", + +Revert to \code{kableExtra} for one session: + +\code{options(modelsummary_factory_default = 'kableExtra')} +\code{options(modelsummary_factory_latex = 'kableExtra')} +\code{options(modelsummary_factory_html = 'kableExtra')} +} + \references{ Arel-Bundock V (2022). “modelsummary: Data and Model Summaries in R.” \emph{Journal of Statistical Software}, \emph{103}(1), 1-23. \doi{10.18637/jss.v103.i01}.' } diff --git a/man/datasummary_skim.Rd b/man/datasummary_skim.Rd index c6750dc42..c974d2c33 100644 --- a/man/datasummary_skim.Rd +++ b/man/datasummary_skim.Rd @@ -87,6 +87,19 @@ See the Details and Examples sections below, and the vignettes on the \item https://modelsummary.com/articles/datasummary.html } } +\section{Version 2.0.0, kableExtra, and tinytable}{ + + +Since version 2.0.0, \code{modelsummary} uses \code{tinytable} as its default table-drawing backend. +Learn more at: https://vincentarelbundock.github.io/tinytable/", + +Revert to \code{kableExtra} for one session: + +\code{options(modelsummary_factory_default = 'kableExtra')} +\code{options(modelsummary_factory_latex = 'kableExtra')} +\code{options(modelsummary_factory_html = 'kableExtra')} +} + \section{Global Options}{ diff --git a/man/dsummary.Rd b/man/dsummary.Rd index 74a9ab9f7..2bae7ffd4 100644 --- a/man/dsummary.Rd +++ b/man/dsummary.Rd @@ -117,6 +117,19 @@ Hierarchical or "nested" column labels are only available for these output formats: tinytable, kableExtra, gt, html, rtf, and LaTeX. When saving tables to other formats, nested labels will be combined to a "flat" header. } +\section{Version 2.0.0, kableExtra, and tinytable}{ + + +Since version 2.0.0, \code{modelsummary} uses \code{tinytable} as its default table-drawing backend. +Learn more at: https://vincentarelbundock.github.io/tinytable/", + +Revert to \code{kableExtra} for one session: + +\code{options(modelsummary_factory_default = 'kableExtra')} +\code{options(modelsummary_factory_latex = 'kableExtra')} +\code{options(modelsummary_factory_html = 'kableExtra')} +} + \section{Global Options}{ diff --git a/man/modelsummary.Rd b/man/modelsummary.Rd index afe3aca6f..b9469d979 100644 --- a/man/modelsummary.Rd +++ b/man/modelsummary.Rd @@ -326,6 +326,19 @@ will be adjusted by, for example, taking the square root of the matrix's diagonal. } } +\section{Version 2.0.0, kableExtra, and tinytable}{ + + +Since version 2.0.0, \code{modelsummary} uses \code{tinytable} as its default table-drawing backend. +Learn more at: https://vincentarelbundock.github.io/tinytable/", + +Revert to \code{kableExtra} for one session: + +\code{options(modelsummary_factory_default = 'kableExtra')} +\code{options(modelsummary_factory_latex = 'kableExtra')} +\code{options(modelsummary_factory_html = 'kableExtra')} +} + \section{Global Options}{ @@ -460,7 +473,7 @@ Some users have reported difficult to reproduce errors when using the } \examples{ -\dontshow{if (isTRUE(Sys.getenv("R_NOT_CRAN") == 'true')) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (isTRUE(Sys.getenv("R_NOT_CRAN") == "true")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # The `modelsummary` website includes \emph{many} examples and tutorials: # https://modelsummary.com @@ -469,8 +482,8 @@ library(modelsummary) # load data and estimate models utils::data(trees) models <- list() -models[['Bivariate']] <- lm(Girth ~ Height, data = trees) -models[['Multivariate']] <- lm(Girth ~ Height + Volume, data = trees) +models[["Bivariate"]] <- lm(Girth ~ Height, data = trees) +models[["Multivariate"]] <- lm(Girth ~ Height + Volume, data = trees) # simple table modelsummary(models) @@ -478,15 +491,16 @@ modelsummary(models) # statistic modelsummary(models, statistic = NULL) -modelsummary(models, statistic = 'p.value') +modelsummary(models, statistic = "p.value") -modelsummary(models, statistic = 'statistic') +modelsummary(models, statistic = "statistic") -modelsummary(models, statistic = 'conf.int', conf_level = 0.99) +modelsummary(models, statistic = "conf.int", conf_level = 0.99) -modelsummary(models, statistic = c("t = {statistic}", - "se = {std.error}", - "conf.int")) +modelsummary(models, statistic = c( + "t = {statistic}", + "se = {std.error}", + "conf.int")) # estimate modelsummary(models, @@ -494,8 +508,9 @@ modelsummary(models, estimate = "{estimate} [{conf.low}, {conf.high}]") modelsummary(models, - estimate = c("{estimate}{stars}", - "{estimate} ({std.error})")) + estimate = c( + "{estimate}{stars}", + "{estimate} ({std.error})")) # vcov modelsummary(models, vcov = "robust") @@ -508,14 +523,16 @@ modelsummary(models, vcov = list(stats::vcov, sandwich::vcovHC)) modelsummary(models, - vcov = list(c("(Intercept)"="", "Height"="!"), - c("(Intercept)"="", "Height"="!", "Volume"="!!"))) + vcov = list( + c("(Intercept)" = "", "Height" = "!"), + c("(Intercept)" = "", "Height" = "!", "Volume" = "!!"))) # vcov with custom names modelsummary( models, - vcov = list("Stata Corp" = "stata", - "Newey Lewis & the News" = "NeweyWest")) + vcov = list( + "Stata Corp" = "stata", + "Newey Lewis & the News" = "NeweyWest")) # fmt mod <- lm(mpg ~ hp + drat + qsec, data = mtcars) @@ -539,7 +556,7 @@ f <- function(x) format(x, digits = 3, nsmall = 2, scientific = FALSE, trim = TR modelsummary(m, fmt = f, gof_map = NA) # coef_rename -modelsummary(models, coef_rename = c('Volume' = 'Large', 'Height' = 'Tall')) +modelsummary(models, coef_rename = c("Volume" = "Large", "Height" = "Tall")) modelsummary(models, coef_rename = toupper) @@ -558,9 +575,9 @@ m <- lm(hp ~ mpg + factor(cyl), data = mtcars) modelsummary(m, coef_omit = -(3:4), coef_rename = c("Cyl 6", "Cyl 8")) # coef_map -modelsummary(models, coef_map = c('Volume' = 'Large', 'Height' = 'Tall')) +modelsummary(models, coef_map = c("Volume" = "Large", "Height" = "Tall")) -modelsummary(models, coef_map = c('Volume', 'Height')) +modelsummary(models, coef_map = c("Volume", "Height")) # coef_omit: omit the first and second coefficients modelsummary(models, coef_omit = 1:2) @@ -572,70 +589,71 @@ modelsummary(models, coef_omit = "ei", gof_omit = ".*") modelsummary(models, coef_omit = "^Volume$", gof_omit = ".*") # coef_omit: omit coefficients matching either one of two substring -#modelsummary(models, coef_omit = "ei|rc", gof_omit = ".*") +# modelsummary(models, coef_omit = "ei|rc", gof_omit = ".*") # coef_omit: keep coefficients starting with a substring (using a negative lookahead) -#modelsummary(models, coef_omit = "^(?!Vol)", gof_omit = ".*") +# modelsummary(models, coef_omit = "^(?!Vol)", gof_omit = ".*") # coef_omit: keep coefficients matching a substring modelsummary(models, coef_omit = "^(?!.*ei|.*pt)", gof_omit = ".*") # shape: multinomial model library(nnet) -multi <- multinom(factor(cyl) ~ mpg + hp, data = mtcars, trace = FALSE) +multi <- multinom(factor(cyl) ~ mpg + hp, data = mtcars, trace = FALSE) # shape: term names and group ids in rows, models in columns modelsummary(multi, shape = response ~ model) # shape: term names and group ids in rows in a single column -modelsummary(multi, shape = term : response ~ model) +modelsummary(multi, shape = term:response ~ model) # shape: term names in rows and group ids in columns modelsummary(multi, shape = term ~ response:model) # shape = "rcollapse" panels <- list( - "Panel A: MPG" = list( - "A" = lm(mpg ~ hp, data = mtcars), - "B" = lm(mpg ~ hp + factor(gear), data = mtcars)), - "Panel B: Displacement" = list( - "A" = lm(disp ~ hp, data = mtcars), - "C" = lm(disp ~ hp + factor(gear), data = mtcars)) + "Panel A: MPG" = list( + "A" = lm(mpg ~ hp, data = mtcars), + "B" = lm(mpg ~ hp + factor(gear), data = mtcars)), + "Panel B: Displacement" = list( + "A" = lm(disp ~ hp, data = mtcars), + "C" = lm(disp ~ hp + factor(gear), data = mtcars)) ) # shape = "cbind" modelsummary(panels, shape = "cbind") modelsummary( - panels, - shape = "rbind", - gof_map = c("nobs", "r.squared")) + panels, + shape = "rbind", + gof_map = c("nobs", "r.squared")) # title -modelsummary(models, title = 'This is the title') +modelsummary(models, title = "This is the title") # title with LaTeX label (for numbering and referencing) -modelsummary(models, title = 'This is the title \\\\label{tab:description}', escape = FALSE) +modelsummary(models, title = "This is the title \\\\label{tab:description}", escape = FALSE) # add_rows -rows <- tibble::tribble(~term, ~Bivariate, ~Multivariate, - 'Empty row', '-', '-', - 'Another empty row', '?', '?') -attr(rows, 'position') <- c(1, 3) +rows <- tibble::tribble( + ~term, ~Bivariate, ~Multivariate, + "Empty row", "-", "-", + "Another empty row", "?", "?") +attr(rows, "position") <- c(1, 3) modelsummary(models, add_rows = rows) # notes -modelsummary(models, notes = list('A first note', 'A second note')) +modelsummary(models, notes = list("A first note", "A second note")) # gof_map: tribble library(tibble) gm <- tribble( - ~raw, ~clean, ~fmt, + ~raw, ~clean, ~fmt, "r.squared", "R Squared", 5) modelsummary(models, gof_map = gm) # gof_map: list of lists -f <- function(x) format(round(x, 3), big.mark=",") +f <- function(x) format(round(x, 3), big.mark = ",") gm <- list( list("raw" = "nobs", "clean" = "N", "fmt" = f), list("raw" = "AIC", "clean" = "aic", "fmt" = f)) diff --git a/man/msummary.Rd b/man/msummary.Rd index 08e4c3ff0..bc73e64a8 100644 --- a/man/msummary.Rd +++ b/man/msummary.Rd @@ -326,6 +326,19 @@ will be adjusted by, for example, taking the square root of the matrix's diagonal. } } +\section{Version 2.0.0, kableExtra, and tinytable}{ + + +Since version 2.0.0, \code{modelsummary} uses \code{tinytable} as its default table-drawing backend. +Learn more at: https://vincentarelbundock.github.io/tinytable/", + +Revert to \code{kableExtra} for one session: + +\code{options(modelsummary_factory_default = 'kableExtra')} +\code{options(modelsummary_factory_latex = 'kableExtra')} +\code{options(modelsummary_factory_html = 'kableExtra')} +} + \section{Global Options}{ @@ -460,7 +473,7 @@ Some users have reported difficult to reproduce errors when using the } \examples{ -\dontshow{if (isTRUE(Sys.getenv("R_NOT_CRAN") == 'true')) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (isTRUE(Sys.getenv("R_NOT_CRAN") == "true")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # The `modelsummary` website includes \emph{many} examples and tutorials: # https://modelsummary.com @@ -469,8 +482,8 @@ library(modelsummary) # load data and estimate models utils::data(trees) models <- list() -models[['Bivariate']] <- lm(Girth ~ Height, data = trees) -models[['Multivariate']] <- lm(Girth ~ Height + Volume, data = trees) +models[["Bivariate"]] <- lm(Girth ~ Height, data = trees) +models[["Multivariate"]] <- lm(Girth ~ Height + Volume, data = trees) # simple table modelsummary(models) @@ -478,15 +491,16 @@ modelsummary(models) # statistic modelsummary(models, statistic = NULL) -modelsummary(models, statistic = 'p.value') +modelsummary(models, statistic = "p.value") -modelsummary(models, statistic = 'statistic') +modelsummary(models, statistic = "statistic") -modelsummary(models, statistic = 'conf.int', conf_level = 0.99) +modelsummary(models, statistic = "conf.int", conf_level = 0.99) -modelsummary(models, statistic = c("t = {statistic}", - "se = {std.error}", - "conf.int")) +modelsummary(models, statistic = c( + "t = {statistic}", + "se = {std.error}", + "conf.int")) # estimate modelsummary(models, @@ -494,8 +508,9 @@ modelsummary(models, estimate = "{estimate} [{conf.low}, {conf.high}]") modelsummary(models, - estimate = c("{estimate}{stars}", - "{estimate} ({std.error})")) + estimate = c( + "{estimate}{stars}", + "{estimate} ({std.error})")) # vcov modelsummary(models, vcov = "robust") @@ -508,14 +523,16 @@ modelsummary(models, vcov = list(stats::vcov, sandwich::vcovHC)) modelsummary(models, - vcov = list(c("(Intercept)"="", "Height"="!"), - c("(Intercept)"="", "Height"="!", "Volume"="!!"))) + vcov = list( + c("(Intercept)" = "", "Height" = "!"), + c("(Intercept)" = "", "Height" = "!", "Volume" = "!!"))) # vcov with custom names modelsummary( models, - vcov = list("Stata Corp" = "stata", - "Newey Lewis & the News" = "NeweyWest")) + vcov = list( + "Stata Corp" = "stata", + "Newey Lewis & the News" = "NeweyWest")) # fmt mod <- lm(mpg ~ hp + drat + qsec, data = mtcars) @@ -539,7 +556,7 @@ f <- function(x) format(x, digits = 3, nsmall = 2, scientific = FALSE, trim = TR modelsummary(m, fmt = f, gof_map = NA) # coef_rename -modelsummary(models, coef_rename = c('Volume' = 'Large', 'Height' = 'Tall')) +modelsummary(models, coef_rename = c("Volume" = "Large", "Height" = "Tall")) modelsummary(models, coef_rename = toupper) @@ -558,9 +575,9 @@ m <- lm(hp ~ mpg + factor(cyl), data = mtcars) modelsummary(m, coef_omit = -(3:4), coef_rename = c("Cyl 6", "Cyl 8")) # coef_map -modelsummary(models, coef_map = c('Volume' = 'Large', 'Height' = 'Tall')) +modelsummary(models, coef_map = c("Volume" = "Large", "Height" = "Tall")) -modelsummary(models, coef_map = c('Volume', 'Height')) +modelsummary(models, coef_map = c("Volume", "Height")) # coef_omit: omit the first and second coefficients modelsummary(models, coef_omit = 1:2) @@ -572,70 +589,71 @@ modelsummary(models, coef_omit = "ei", gof_omit = ".*") modelsummary(models, coef_omit = "^Volume$", gof_omit = ".*") # coef_omit: omit coefficients matching either one of two substring -#modelsummary(models, coef_omit = "ei|rc", gof_omit = ".*") +# modelsummary(models, coef_omit = "ei|rc", gof_omit = ".*") # coef_omit: keep coefficients starting with a substring (using a negative lookahead) -#modelsummary(models, coef_omit = "^(?!Vol)", gof_omit = ".*") +# modelsummary(models, coef_omit = "^(?!Vol)", gof_omit = ".*") # coef_omit: keep coefficients matching a substring modelsummary(models, coef_omit = "^(?!.*ei|.*pt)", gof_omit = ".*") # shape: multinomial model library(nnet) -multi <- multinom(factor(cyl) ~ mpg + hp, data = mtcars, trace = FALSE) +multi <- multinom(factor(cyl) ~ mpg + hp, data = mtcars, trace = FALSE) # shape: term names and group ids in rows, models in columns modelsummary(multi, shape = response ~ model) # shape: term names and group ids in rows in a single column -modelsummary(multi, shape = term : response ~ model) +modelsummary(multi, shape = term:response ~ model) # shape: term names in rows and group ids in columns modelsummary(multi, shape = term ~ response:model) # shape = "rcollapse" panels <- list( - "Panel A: MPG" = list( - "A" = lm(mpg ~ hp, data = mtcars), - "B" = lm(mpg ~ hp + factor(gear), data = mtcars)), - "Panel B: Displacement" = list( - "A" = lm(disp ~ hp, data = mtcars), - "C" = lm(disp ~ hp + factor(gear), data = mtcars)) + "Panel A: MPG" = list( + "A" = lm(mpg ~ hp, data = mtcars), + "B" = lm(mpg ~ hp + factor(gear), data = mtcars)), + "Panel B: Displacement" = list( + "A" = lm(disp ~ hp, data = mtcars), + "C" = lm(disp ~ hp + factor(gear), data = mtcars)) ) # shape = "cbind" modelsummary(panels, shape = "cbind") modelsummary( - panels, - shape = "rbind", - gof_map = c("nobs", "r.squared")) + panels, + shape = "rbind", + gof_map = c("nobs", "r.squared")) # title -modelsummary(models, title = 'This is the title') +modelsummary(models, title = "This is the title") # title with LaTeX label (for numbering and referencing) -modelsummary(models, title = 'This is the title \\\\label{tab:description}', escape = FALSE) +modelsummary(models, title = "This is the title \\\\label{tab:description}", escape = FALSE) # add_rows -rows <- tibble::tribble(~term, ~Bivariate, ~Multivariate, - 'Empty row', '-', '-', - 'Another empty row', '?', '?') -attr(rows, 'position') <- c(1, 3) +rows <- tibble::tribble( + ~term, ~Bivariate, ~Multivariate, + "Empty row", "-", "-", + "Another empty row", "?", "?") +attr(rows, "position") <- c(1, 3) modelsummary(models, add_rows = rows) # notes -modelsummary(models, notes = list('A first note', 'A second note')) +modelsummary(models, notes = list("A first note", "A second note")) # gof_map: tribble library(tibble) gm <- tribble( - ~raw, ~clean, ~fmt, + ~raw, ~clean, ~fmt, "r.squared", "R Squared", 5) modelsummary(models, gof_map = gm) # gof_map: list of lists -f <- function(x) format(round(x, 3), big.mark=",") +f <- function(x) format(round(x, 3), big.mark = ",") gm <- list( list("raw" = "nobs", "clean" = "N", "fmt" = f), list("raw" = "AIC", "clean" = "aic", "fmt" = f)) From 347576cc9ad78598db904b087ae5588b30b78d9a Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sat, 16 Nov 2024 09:31:45 -0500 Subject: [PATCH 5/5] test-gt --- R/factory_gt.R | 36 +++++----- .../_tinysnapshot/gt-background_color.html | 16 ++--- inst/tinytest/_tinysnapshot/gt-complex.html | 22 +++--- inst/tinytest/_tinysnapshot/gt-title.html | 16 ++--- inst/tinytest/helpers.R | 13 ++-- inst/tinytest/test-gt.R | 68 +++++++++---------- 6 files changed, 83 insertions(+), 88 deletions(-) diff --git a/R/factory_gt.R b/R/factory_gt.R index 7b8e769d2..c901d584b 100644 --- a/R/factory_gt.R +++ b/R/factory_gt.R @@ -15,8 +15,7 @@ factory_gt <- function(tab, output_format = "gt", output_file = NULL, ...) { - - insight::check_if_installed("gt", minimum_version = "0.5.0") + insight::check_if_installed("gt", minimum_version = "0.11.1") # compute spans span_list <- get_span_gt(tab) @@ -33,11 +32,11 @@ factory_gt <- function(tab, # theme theme_ms <- getOption("modelsummary_theme_gt", - default = theme_ms_gt) + default = theme_ms_gt) out <- theme_ms(out, - output_format = output_format, - hrule = hrule, - hgroup = hgroup) + output_format = output_format, + hrule = hrule, + hgroup = hgroup) # user-supplied notes at the bottom of table if (!is.null(notes)) { @@ -49,28 +48,30 @@ factory_gt <- function(tab, if (length(span_list) > 0) { for (s in span_list) { out <- gt::tab_spanner(out, - label = s$label, - columns = tidyselect::all_of(s$columns), - level = s$level) + label = s$label, + columns = tidyselect::all_of(s$columns), + level = s$level) } } # column alignment if (!is.null(align)) { - left <- grep('l', align) - center <- grep('c', align) - right <- grep('r', align) + left <- grep("l", align) + center <- grep("c", align) + right <- grep("r", align) out <- gt::cols_align( - out, align = 'center', columns = tidyselect::all_of(center)) + out, + align = "center", columns = tidyselect::all_of(center)) out <- gt::cols_align( - out, align = 'left', columns = tidyselect::all_of(left)) + out, + align = "left", columns = tidyselect::all_of(left)) out <- gt::cols_align( - out, align = 'right', column = tidyselect::all_of(right)) + out, + align = "right", column = tidyselect::all_of(right)) } # output if (is.null(output_file)) { - if (identical(output_format, "html")) { out <- gt::as_raw_html(out) } @@ -80,7 +81,7 @@ factory_gt <- function(tab, } if (!is.null(getOption("modelsummary_orgmode")) && - output_format %in% c("html", "latex")) { + output_format %in% c("html", "latex")) { out <- sprintf("#+BEGIN_EXPORT %s\n%s\n#+END_EXPORT", output_format, out) return(out) } @@ -88,7 +89,6 @@ factory_gt <- function(tab, if (output_format %in% c("default", "gt")) { return(out) } - } else { gt::gtsave(out, output_file) } diff --git a/inst/tinytest/_tinysnapshot/gt-background_color.html b/inst/tinytest/_tinysnapshot/gt-background_color.html index 9186748ae..70a241d9c 100644 --- a/inst/tinytest/_tinysnapshot/gt-background_color.html +++ b/inst/tinytest/_tinysnapshot/gt-background_color.html @@ -1,15 +1,13 @@ -< style="padding-left:0px;padding-right:0px;padding-top:10px;padding-bottom:10px;overflow-x:auto;overflow-y:auto;width:auto;height:auto;"> - -
+
- - - - - - + + + + + + diff --git a/inst/tinytest/_tinysnapshot/gt-complex.html b/inst/tinytest/_tinysnapshot/gt-complex.html index 2ce3bd256..6fb79f6dc 100644 --- a/inst/tinytest/_tinysnapshot/gt-complex.html +++ b/inst/tinytest/_tinysnapshot/gt-complex.html @@ -1,6 +1,4 @@ -< style="padding-left:0px;padding-right:0px;padding-top:10px;padding-bottom:10px;overflow-x:auto;overflow-y:auto;width:auto;height:auto;"> - -
colors
OLS 1Poisson 1OLS 2Logit 1Logit 2 OLS 1Poisson 1OLS 2Logit 1Logit 2
+
@@ -9,23 +7,23 @@ - + - - - - - + + + + + diff --git a/inst/tinytest/_tinysnapshot/gt-title.html b/inst/tinytest/_tinysnapshot/gt-title.html index 75fddf55b..b3ebb2a1e 100644 --- a/inst/tinytest/_tinysnapshot/gt-title.html +++ b/inst/tinytest/_tinysnapshot/gt-title.html @@ -1,15 +1,13 @@ -< style="padding-left:0px;padding-right:0px;padding-top:10px;padding-bottom:10px;overflow-x:auto;overflow-y:auto;width:auto;height:auto;"> - -
Summarizing 5 statistical models using the `modelsummary` package for `R`.Models estimated using the mtcars dataset.
- Horsepower +
Horsepower
 - V-Shape +
V-Shape
 - Transmission +
Transmission
OLS 1Poisson 1OLS 2Logit 1Logit 2OLS 1Poisson 1OLS 2Logit 1Logit 2
+
- - - - - - + + + + + + diff --git a/inst/tinytest/helpers.R b/inst/tinytest/helpers.R index 3d52b585d..67a2ef751 100644 --- a/inst/tinytest/helpers.R +++ b/inst/tinytest/helpers.R @@ -4,8 +4,8 @@ suppressWarnings(modelsummary::config_modelsummary(reset = TRUE)) ON_CRAN <- !identical(Sys.getenv("R_NOT_CRAN"), "true") ON_GH <- identical(Sys.getenv("R_GH"), "true") ON_CI <- isTRUE(ON_CRAN) || isTRUE(ON_GH) -ON_WINDOWS <- isTRUE(Sys.info()[['sysname']] == "Windows") -ON_OSX <- isTRUE(Sys.info()[['sysname']] == "Darwin") +ON_WINDOWS <- isTRUE(Sys.info()[["sysname"]] == "Windows") +ON_OSX <- isTRUE(Sys.info()[["sysname"]] == "Darwin") requiet <- function(package) { suppressMessages(suppressWarnings(suppressPackageStartupMessages( @@ -14,7 +14,7 @@ requiet <- function(package) { } random_string <- function() { - paste(sample(letters, 30, replace=TRUE), collapse="") + paste(sample(letters, 30, replace = TRUE), collapse = "") } compare_files <- function(x, y) { @@ -24,8 +24,8 @@ compare_files <- function(x, y) { } print.custom_html_string <- function(x, ...) { - cat(x, "\n", sep = "", ...) - invisible(x) + cat(x, "\n", sep = "", ...) + invisible(x) } @@ -33,7 +33,8 @@ print_html <- function(x) { set.seed(1024) if (inherits(x, "gt_tbl")) { x <- gt::as_raw_html(x) - x <- gsub('div id="\\w+"', '', x) + x <- gsub('div id="\\w+"', "", x) + x <- gsub(".*% - gt::tab_spanner(label = "Horsepower", columns = c(`OLS 1`, `Poisson 1`)) %>% - gt::tab_spanner(label = "V-Shape", columns = c(`OLS 2`, `Logit 1`)) %>% - gt::tab_spanner(label = "Transmission", columns = `Logit 2`) %>% - gt::tab_header( - title = "Summarizing 5 statistical models using the `modelsummary` package for `R`.", - subtitle = "Models estimated using the mtcars dataset.") + modelsummary( + models, + output = "gt", + coef_map = cm, + stars = TRUE, + gof_omit = "Statistics|^p$|Deviance|Resid|Sigma|Log.Lik|^DF$", + notes = c( + "First custom note to contain text.", + "Second custom note with different content.") + ) %>% + gt::tab_spanner(label = "Horsepower", columns = c(`OLS 1`, `Poisson 1`)) %>% + gt::tab_spanner(label = "V-Shape", columns = c(`OLS 2`, `Logit 1`)) %>% + gt::tab_spanner(label = "Transmission", columns = `Logit 2`) %>% + gt::tab_header( + title = "Summarizing 5 statistical models using the `modelsummary` package for `R`.", + subtitle = "Models estimated using the mtcars dataset.") suppressWarnings(expect_snapshot_print(print_html(raw), "gt-complex.html")) # title @@ -51,16 +51,16 @@ suppressWarnings(expect_snapshot_print(print_html(raw), "gt-title.html")) # background color raw <- modelsummary(models, output = "gt", title = "colors") %>% - tab_style( - style = cell_text(weight = "bold"), - locations = cells_body(columns = c(`OLS 1`))) %>% - tab_style( - style = cell_text(style = "italic"), - locations = cells_body(columns = c(`Poisson 1`), rows = 2:6)) %>% - tab_style( - style = cell_fill(color = "lightcyan"), - locations = cells_body(columns = c(`OLS 1`))) %>% - tab_style( - style = cell_fill(color = "#F9E3D6"), - locations = cells_body(columns = c(`Logit 2`), rows = 2:6)) + tab_style( + style = cell_text(weight = "bold"), + locations = cells_body(columns = c(`OLS 1`))) %>% + tab_style( + style = cell_text(style = "italic"), + locations = cells_body(columns = c(`Poisson 1`), rows = 2:6)) %>% + tab_style( + style = cell_fill(color = "lightcyan"), + locations = cells_body(columns = c(`OLS 1`))) %>% + tab_style( + style = cell_fill(color = "#F9E3D6"), + locations = cells_body(columns = c(`Logit 2`), rows = 2:6)) suppressWarnings(expect_snapshot_print(print_html(raw), "gt-background_color.html"))
This is a title for my table.
OLS 1Poisson 1OLS 2Logit 1Logit 2 OLS 1Poisson 1OLS 2Logit 1Logit 2