From 80cd1eb4d5abf360ad68780654204e94a2303046 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Wed, 22 May 2024 12:19:47 -0400 Subject: [PATCH 1/3] Update CI to the most recent versions (#574) --- .github/workflows/R-CMD-check.yaml | 5 ++++- .github/workflows/pkgdown.yaml | 8 ++++++-- .github/workflows/style.yaml | 8 ++++++-- .github/workflows/test-coverage.yaml | 22 +++++++++++++++++----- 4 files changed, 33 insertions(+), 10 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 55742ef3..008f9bec 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -8,6 +8,8 @@ on: name: R-CMD-check +permissions: read-all + jobs: R-CMD-check: runs-on: ${{ matrix.config.os }} @@ -29,7 +31,7 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 @@ -49,3 +51,4 @@ jobs: - uses: r-lib/actions/check-r-package@v2 with: upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 087f0b05..c9f0165d 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -11,6 +11,8 @@ on: name: pkgdown +permissions: read-all + jobs: pkgdown: runs-on: ubuntu-latest @@ -19,8 +21,10 @@ jobs: group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 @@ -39,7 +43,7 @@ jobs: - name: Deploy to GitHub pages 🚀 if: github.event_name != 'pull_request' - uses: JamesIves/github-pages-deploy-action@v4.4.1 + uses: JamesIves/github-pages-deploy-action@v4.5.0 with: clean: false branch: gh-pages diff --git a/.github/workflows/style.yaml b/.github/workflows/style.yaml index bee3e482..fd16f694 100644 --- a/.github/workflows/style.yaml +++ b/.github/workflows/style.yaml @@ -6,14 +6,18 @@ on: name: Style +permissions: read-all + jobs: style: runs-on: ubuntu-latest + permissions: + contents: write env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - name: Checkout repo - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 @@ -46,7 +50,7 @@ jobs: shell: Rscript {0} - name: Cache styler - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{ steps.styler-location.outputs.location }} key: ${{ runner.os }}-styler-${{ github.sha }} diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 42ae31d9..e9da5d0f 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -8,6 +8,8 @@ on: name: test-coverage +permissions: read-all + jobs: test-coverage: runs-on: ubuntu-latest @@ -15,7 +17,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-r@v2 with: @@ -26,27 +28,37 @@ jobs: extra-packages: | any::sf any::covr + any::xml2 needs: coverage - name: Test coverage run: | - covr::codecov( + cov <- covr::package_coverage( quiet = FALSE, clean = FALSE, - install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package") + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") ) + covr::to_cobertura(cov) shell: Rscript {0} + - uses: codecov/codecov-action@v4 + with: + fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }} + file: ./cobertura.xml + plugin: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + - name: Show testthat output if: always() run: | ## -------------------------------------------------------------------- - find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true shell: bash - name: Upload test results if: failure() - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: coverage-test-failures path: ${{ runner.temp }}/package From cd472024af182df370754e01cda057ef7a55c2d3 Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Thu, 27 Jun 2024 14:25:27 -0400 Subject: [PATCH 2/3] tabyl uses labels (#575) * Import `%||%` from rlang. * Add support for displaying the label attribute for column name. * Reduce space * Style code (GHA) * style * Handle 2-3 ways tabyl as well. * Clarify explanation comments Co-authored-by: Sam Firke * Update NEWS.md * Update NEWS.md * reword breaking change --------- Co-authored-by: olivroy Co-authored-by: Sam Firke --- NAMESPACE | 1 + NEWS.md | 3 +++ R/get_dupes.R | 2 +- R/print_tabyl.R | 1 - R/tabyl.R | 34 ++++++++++++++++++++++++++-------- tests/testthat/test-tabyl.R | 11 +++++++++++ 6 files changed, 42 insertions(+), 10 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 27073345..1461f757 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -69,6 +69,7 @@ importFrom(lubridate,second) importFrom(lubridate,ymd) importFrom(lubridate,ymd_hms) importFrom(magrittr,"%>%") +importFrom(rlang,"%||%") importFrom(rlang,dots_n) importFrom(rlang,expr) importFrom(rlang,syms) diff --git a/NEWS.md b/NEWS.md index 5d715ce2..c4356e67 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,9 @@ These are all minor breaking changes resulting from enhancements and are not exp * When using `row_to_names()`, when all input values in `row_number` for a column are `NA`, `row_to_names()` creates a column name of `"NA"`, a character, rather than `NA`. If code previously used relied on a column name of `NA`, it will now error. To fix this, rely on a column name of `"NA"`. +* When `tabyl()` is called on a data.frame containing labels, it now displays the label attribute as the name of the first column in the the resulting `tabyl` object (@olivroy, #394). This may break subsequent code that refers to the output of such a `tabyl` by column name. To maintain the previous behavior of ignoring variable labels, you can remove the labels with a function like `haven::zap_labels()` or `labelled::remove_labels()` before calling `tabyl()`. + + ## New features * A new function `paste_skip_na()` pastes without including NA values (#537). diff --git a/R/get_dupes.R b/R/get_dupes.R index b86e409c..0a37f077 100644 --- a/R/get_dupes.R +++ b/R/get_dupes.R @@ -22,7 +22,7 @@ #' mtcars %>% get_dupes(-c(wt, qsec)) #' mtcars %>% get_dupes(starts_with("cy")) #' @importFrom tidyselect eval_select -#' @importFrom rlang expr dots_n syms +#' @importFrom rlang expr dots_n syms %||% get_dupes <- function(dat, ...) { expr <- rlang::expr(c(...)) pos <- tidyselect::eval_select(expr, data = dat) diff --git a/R/print_tabyl.R b/R/print_tabyl.R index 62832419..b971bc40 100644 --- a/R/print_tabyl.R +++ b/R/print_tabyl.R @@ -1,5 +1,4 @@ #' @export - print.tabyl <- function(x, ...) { print.data.frame(x, row.names = FALSE) } diff --git a/R/tabyl.R b/R/tabyl.R index 6fddebdd..fca82750 100644 --- a/R/tabyl.R +++ b/R/tabyl.R @@ -66,7 +66,6 @@ tabyl.default <- function(dat, show_na = TRUE, show_missing_levels = TRUE, ...) var_name <- names(dat) } - # useful error message if input vector doesn't exist if (is.null(dat)) { stop(paste0("object ", var_name, " not found")) @@ -76,6 +75,13 @@ tabyl.default <- function(dat, show_na = TRUE, show_missing_levels = TRUE, ...) var_name <- paste(var_name, collapse = "") } + # Try to retrieve label + if (is.data.frame(dat)) { + var_label <- attr(dat[, var_name], "label", exact = TRUE) %||% var_name + } else { + var_label <- attr(dat, "label", exact = TRUE) %||% var_name + } + # if show_na is not length-1 logical, error helpfully (#377) if (length(show_na) > 1 || !inherits(show_na, "logical")) { stop("The value supplied to the \"show_na\" argument must be TRUE or FALSE.\n\nDid you try to call tabyl on two vectors, like tabyl(data$var1, data$var2) ? To create a two-way tabyl, the two vectors must be in the same data.frame, and the function should be called like this: \n @@ -133,8 +139,8 @@ tabyl.default <- function(dat, show_na = TRUE, show_missing_levels = TRUE, ...) dplyr::mutate(percent = n / sum(n, na.rm = TRUE)) # recalculate % without NAs } - # reassign correct variable name - names(result)[1] <- var_name + # reassign correct variable name (or label if it exists) + names(result)[1] <- var_label # in case input var name was "n" or "percent", call helper function to set unique names result <- handle_if_special_names_used(result) @@ -238,10 +244,11 @@ tabyl_2way <- function(dat, var1, var2, show_na = TRUE, show_missing_levels = TR result <- result[c(setdiff(names(result), "NA_"), "NA_")] } - - result %>% - data.frame(., check.names = FALSE) %>% - as_tabyl(axes = 2, row_var_name = names(dat)[1], col_var_name = names(dat)[2]) + row_var_name <- names(dat)[1] + col_var_name <- names(dat)[2] + names(result)[1] <- attr(dat[, 1], "label", exact = TRUE) %||% names(result)[1] + data.frame(result, check.names = FALSE) %>% + as_tabyl(axes = 2, row_var_name = row_var_name, col_var_name = col_var_name) } @@ -250,6 +257,10 @@ tabyl_3way <- function(dat, var1, var2, var3, show_na = TRUE, show_missing_level dat <- dplyr::select(dat, !!var1, !!var2, !!var3) var3_numeric <- is.numeric(dat[[3]]) + # Preserve labels, as attributes are sometimes dropped during transformations. + var1_label <- attr(dat[, 1], "label", exact = TRUE) + var2_label <- attr(dat[, 2], "label", exact = TRUE) + # Keep factor levels for ordering the list at the end if (is.factor(dat[[3]])) { third_levels_for_sorting <- levels(dat[[3]]) @@ -277,7 +288,14 @@ tabyl_3way <- function(dat, var1, var2, var3, show_na = TRUE, show_missing_level dat[[2]] <- as.factor(dat[[2]]) } - result <- split(dat, dat[[rlang::quo_name(var3)]]) %>% + result <- split(dat, dat[[rlang::quo_name(var3)]]) + # split() drops attributes, so we manually add back the label attributes. + result <- lapply(result, function(x) { + attr(x[[1]], "label") <- var1_label + attr(x[[2]], "label") <- var2_label + x + }) + result <- result %>% purrr::map(tabyl_2way, var1, var2, show_na = show_na, show_missing_levels = show_missing_levels) %>% purrr::map(reset_1st_col_status, col1_class, col1_levels) # reset class of var in 1st col to its input class, #168 diff --git a/tests/testthat/test-tabyl.R b/tests/testthat/test-tabyl.R index 7667e15f..4226e987 100644 --- a/tests/testthat/test-tabyl.R +++ b/tests/testthat/test-tabyl.R @@ -395,6 +395,17 @@ test_that("3-way tabyl with 3rd var factor is listed in right order, #250", { expect_equal(names(tabyl(z, am, gear, cyl)), c("8", "6", "NA_")) }) +test_that("tabyl works with label attributes (#394)", { + mt_label <- mtcars + attr(mt_label$cyl, "label") <- "Number of cyl" + tab <- tabyl(mt_label, cyl) + expect_named(tab, c("Number of cyl", "n", "percent")) + tab2 <- tabyl(mt_label, cyl, am) + expect_named(tab2, c("Number of cyl", "0", "1")) + tab3 <- tabyl(mt_label, cyl, am, vs) + expect_equal(names(tab3[[1]])[1], "Number of cyl") +}) + test_that("tabyl works with ordered 1st variable, #386", { mt_ordered <- mtcars mt_ordered$cyl <- ordered(mt_ordered$cyl, levels = c("4", "8", "6")) From 709b2abb38dd98252da479388db35e9106526561 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Thu, 12 Sep 2024 14:36:15 -0400 Subject: [PATCH 3/3] Fix issue where the sf package "sf_column" may not be the last column in an sf object (#579) --- NEWS.md | 2 ++ R/clean_names.R | 10 +++++----- tests/testthat/test-clean-names.R | 9 +++++++++ tests/testthat/testdata/issue-578-sf.rds | Bin 0 -> 8256 bytes 4 files changed, 16 insertions(+), 5 deletions(-) create mode 100644 tests/testthat/testdata/issue-578-sf.rds diff --git a/NEWS.md b/NEWS.md index c4356e67..73de1b00 100644 --- a/NEWS.md +++ b/NEWS.md @@ -25,6 +25,8 @@ These are all minor breaking changes resulting from enhancements and are not exp * `get_one_to_one()` no longer errors with near-equal values that become identical factor levels (fix #543, thanks to @olivroy for reporting) +* `clean_names()` for sf objects now works in cases when the sf_column is not the last column name (fix #578, thanks to @ar-puuk for reporting and @billdenney for fixing) + ## Refactoring * Remove dplyr verbs superseded in dplyr 1.0.0 (#547, @olivroy) diff --git a/R/clean_names.R b/R/clean_names.R index b8fe3b5f..ee8efe6e 100644 --- a/R/clean_names.R +++ b/R/clean_names.R @@ -97,14 +97,14 @@ clean_names.sf <- function(dat, ...) { } # nocov end # get old names sf_names <- names(dat) - # identify ending column index to clean - n_cols <- length(dat) - 1 + # Clean the names except for the "sf_column" which is used internally by sf + cols_to_rename <- which(!(sf_names %in% attr(dat, "sf_column"))) # clean all but last column - sf_cleaned <- make_clean_names(sf_names[1:n_cols], ...) + sf_cleaned <- make_clean_names(sf_names[cols_to_rename], ...) # rename original df - names(dat)[1:n_cols] <- sf_cleaned + names(dat)[cols_to_rename] <- sf_cleaned - return(dat) + dat } #' @rdname clean_names diff --git a/tests/testthat/test-clean-names.R b/tests/testthat/test-clean-names.R index 96e8809c..45ea6e3f 100644 --- a/tests/testthat/test-clean-names.R +++ b/tests/testthat/test-clean-names.R @@ -461,6 +461,15 @@ test_that("Names are cleaned appropriately without attaching sf", { expect_equal(names(clean)[4], "cnty_id") expect_s3_class(clean, "sf") + + # Issue #578, sf_column attribute needs to be untouched, it may not be the + # last column name + issue_578_sf <- readRDS("testdata/issue-578-sf.rds") + issue_578_sf_clean <- clean_names(issue_578_sf) + expect_error( + print(issue_578_sf_clean), + NA + ) }) test_that("Names are cleaned appropriately", { diff --git a/tests/testthat/testdata/issue-578-sf.rds b/tests/testthat/testdata/issue-578-sf.rds new file mode 100644 index 0000000000000000000000000000000000000000..5c208947c091abf2b8847bdb303ca11f20ea69d6 GIT binary patch literal 8256 zcmcIp3v?UhmG;}Q8=3$m&FP`eL|TH=BRi7ckCtRCE4G6lLXy`Gj&a7)NE$qv5u=eE z)0Vh4Au)Lz(?j-<0L4Hdkajs{p<5mc$xDo$ z%c(a9bdL1>ulxA#{qLRoYua;DQc}`VGBQ$A($djPzZO3k_%6gZ7p)v%w#!~nTVSnB z=-O;Xx5Zu1SYRzSx(yAqxXkEkw6>CjuC?6gf;N6}jCPtJYusW8vgukvb4}Y+Y~btA zavsZex|TmWlESj<9=~VjNnppP;yd$!Yu{RO^rtDTDf>rDCNOTw4Xn>(fLB@eU9tkN zdpsqLHk^@$pHy93x=#q9dlkMkOhzHRG;LX?SL7lQOb~-~oi?p~t=?MD)Y|B2Xl!V9 zxIM0h<~oCU#2<(;OV~pm%Wk~=&b%$qd2s&s*>{1%w+#GF1a9L`uXqc%gI~R}1UPc_ zx38i3`>V2_c>wrNZ_9h%0Y02}-T%$Ok^T=WG8CTd+@l z_FiCs@Z5qr@LT%XjgMS%0#Dr6buJ7XU-Za1*lOt?9v?^@10HtnPZUSq8K$!{WUDR^_2UQWANnG)AG;g1Z-^zlTc#ZHWqEYk-g`rf29IM8y*HiO zeg>$%a3C@O4DVj|6S75Uafw2wzUSJH|6?6cc<;mn_P`2b1M8qW8+h=s@BagIe|loc zIok8y&8t$$2G3nTnninh?O4~v!@%EJ_Gi%ek#8jeI(tm`~OsNB^FK1)BkpGiIW zRqtItV$w^m7JLITPdvNt(s(kNU*2inC<8~=Gpfja^+>{kg zrgA0*zs%FP2<*r+87w>W(8UKAL&u@9;BALeSaZ!l{T}FKuKA=ie>9mcq=&A{B##&^ zJM`>th7hefE$|E5*!sEhh|#h`Z#v)KLOe8D)@;AMI(dXn*8^E)&~r3Iei&^3ffsw2 z!nU2ueop=M5AT>qIGEF`;ht+eBh-H>w>wC9^xBp1gV}e(#Ov^znakct*~HxS!SCnM zc<0Vz*B=IUtavI+{k9KQd}jdYaW2?J&r|%yF`n#?UtV+gX`o7`A;jGcO+lj{~Z#=yav=z34k68)FR^7tPk;nFT zU+E?r?Qo?k+dx~j>z&t~ggY*NFg6z+h=Y6fe(SsiJT?y=dlh?OHy>Q}S}kzP@V)~d z5ytjvcK6=4o9xt{_k80BaP6VJN5+AjAJ%UsjM*T`GcPU<4EyPJWADA=nx&1PjoFPg z2YY{+=bVe)6a&L~Ee!OVjDgSJexCHZq8RuW`!ce9j23v}&;0(m>Jg)5hmPKOen0Wh zXn`Nz`p1QH2c3l>Lyt9!%Eu;oC9!Fe^Q6;G#j~NuT;n+l@{M?Y_P^XXN9@oO zhl+8&CgZy13#}$I+lTIXc_i81sI-sIGl=iuQ;XYEz-xHZ#aDfVH8(vAKe59%J^IoM z@mPJF>ba@;)vp~pN&S^uPQMEs)-Ra2nrzbU>>dU`v%BeqHyB`Z>z_ZsI`hq4<`=`j zhJ$@XXI@?KBV`0wYYD$N4y^eV(|0(T&Pn2XQb)&s?>Pk8sskU+htB4T*367>G9J_Y zfjh#E>`g1?L;oEan{L$bs_aiu{h%M+OZs_ttvpM5wVX`JTo0^wYxS_X>JPKjj&Tv>9$=ATRwT@BYM7U+I`2` zM#B4oCr=V?|M7Q53GY3kR1j`m#HPgKj?9DDAG>L1=KuYG@S*1-4B?(dztqNmw)-zf zpi6bYlRZM{7vBmKu00Uc`i_)wt#5g_>oAQkeCT7yGgqBuwC6aqEE?jL{mE}1}&TfKIBpC9piyXqV*O%9LCxRs`3 zEauY5>uye1;k`mckR|Bzb$qFc)IY>`a$!byx4Z#YU0Q>Duivfo3(w?zGU1sqNt-Eg zAwB{^Ed%QcW^4!vlF{yuYi|f~8>Yt5PQ0KQ7j<2s88`EEuL4op{hIVAkp@YQ!|AT8 zDk>_mCQjt|oUWENc9*-u)Xdga6f-NBI$l-+0>`xR5tYgJtF7+kCQB}ZPYvsKz^-*u z%k>GGtYtl|P2eIcYLH<=ydroxiK*q(Xo#^@RusoArR9#s#s;UmrJ=UNROfQj3aiOd zR$N|TD=xPbRaO)hm6jJ371^w|m~5gkK8=p%I!}FTbAzYD6yjBdH(6|*ot;w)ovwx^ z2b8H(cwXugyg`%2IyFmd*yg%MM~s7y4`3Nq6k2WNC8fnhl|`kt%F2@B;&_&%DA~|t zDJd$eG-m8A&Hw0dxf@!VJ4|k;-3NGa;mIMv)7b-SgPERPduEgiv=HttHadDse&5y@r>+eBv@YIL`GJG zfFPMH#aCp3M5|3HQBh%q$){%Hm5`;ttXdRQloZ;^rat9UENCxtb4wykf>K4ZDCPEY zBG33aFD%P&>I~~x3oG$SWbC%H#uOp($Q> zmxJvvwc-@=KE|zbFe#-Kb~#fpnQ#giuN;+B0aFP78m@;|ssU0@gg{Z`J`Gh3d5NhP zL=hvrq6oZ%hS1%OUy=9rh!>-q#q0%bK*&vheT2e}Y6 z$sY9_(ygW#TF@6GJV(mc^O6G6dN~@=ST`tOQq8R4ygl0THC!Z2qSoMH0jfqW#G%(n zW^0uDB%d}I4TXD%s)_TGI!&B{!Uc$P1Y=>hXv3i~RN)CysY#X;8El&HMCWLAR8h$O zP0@%~4v>ImzE9Js1zf4`S2!5J|eW;_zQ5+9XRFO2|J|PgmFye)5)Ed^z+{TGo zNC34hxAEN(O;%eFVO7l#_yt~s$JzwZD{lZ&u1pBTnwpmOj$&(JS&^lnqO`EgW+^U3 z-GELJo*+ivn|dx##nssvtK%|_KlY76HB*qnQB^Pa())VUS?ax5T{olL%hq1ROjei1 z%d1(6=2?bk{>49YWERp{hG){x9GQi5#&F^bs%)u?4~5l!l(6*f#HiOV=_RdUfE(8E zem`PUrt-5_h#*KpsDe-n)%W$ow>};zAfTJw+$bQ9)qcjY0r!DOq>r0g!Z;QAcHV1v z=zEvt+aTdEMX(xYj&XB-9y}XDVMXrcL%gI$ba}Q|#4#=(vy5pJ#D0X7!)oiMMtkeO1zts+mLwuIKG9O(`dyZhwFk|XgmHp(Ct8P@B?=8!fdE}-e7uP+5x zD)gbHg5=*zS~bfml`2SWOdG7B@5LbnImw%_mpmsYhWZtbq*3f8S7}ir?~`dsQiV&9 z=OW!vC4j7t%nI}MqSS)EXz&PZ>@JKbL}3fF>i#h9Q-;H@noRgBz)jy-&g7szkbarD z8H=xAAgLCbQ0){?Mt_E`PcGfO9ClAvL#;lN>8@v;4!tv9pJtj--Romn_LkOW&)Qg; zn7Z5H(OziWGqsnB1Bi%;iHR?!FO2xRys{V#(Tz9$cBl(ZjJ9+xpx`!14AY6B@tu~; zj5okDw=?%0WQlw)FB)z&IL^Z}DWYKLU(PZ&s|{ nhwexb2`daAq(%IOY1MAA%V+e`(bFe#eVob_`V}t36QjQY;eMjZ literal 0 HcmV?d00001