From ba0842701a032b00cea0bb77af9302a14fcfa57b Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Wed, 26 Oct 2022 02:48:14 +0200 Subject: [PATCH] lintr related changes no code change intended. --- .Rbuildignore | 1 + .github/workflows/lint.yaml | 34 +++++++++++ .lintr | 8 +++ R/convert.R | 10 ++-- R/dbcal.R | 61 +++++++++---------- R/read.R | 80 +++++++++++++------------ R/save.R | 102 +++++++++++++++++--------------- R/tools.R | 115 ++++++++++++++++++------------------ man/get.lang.Rd | 2 +- man/set.lang.Rd | 2 +- man/varlabel.Rd | 2 +- tests/testthat/test_read.R | 54 ++++++++--------- tests/testthat/test_save.R | 74 +++++++++++------------ 13 files changed, 299 insertions(+), 246 deletions(-) create mode 100644 .github/workflows/lint.yaml create mode 100644 .lintr diff --git a/.Rbuildignore b/.Rbuildignore index f6b86202..a0b3073c 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -4,3 +4,4 @@ ^_pkgdown\.yml$ ^docs$ ^pkgdown$ +^.lintr$ diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml new file mode 100644 index 00000000..c9878f48 --- /dev/null +++ b/.github/workflows/lint.yaml @@ -0,0 +1,34 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, testing] + pull_request: + branches: [main, testing] + +name: lint + +permissions: read-all + +jobs: + lint: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::lintr, local::. + needs: lint + + - name: Lint + run: lintr::lint_package() + shell: Rscript {0} + env: + LINTR_ERROR_ON_LINT: true diff --git a/.lintr b/.lintr new file mode 100644 index 00000000..c2052aa0 --- /dev/null +++ b/.lintr @@ -0,0 +1,8 @@ +linters: linters_with_defaults( + line_length_linter = NULL, # we have a few + cyclocomp_linter = NULL, # four cases + commented_code_linter = NULL, # a few cases + object_name_linter = NULL, # a few cases + quotes_linter = NULL, # one case + indentation_linter = NULL + ) diff --git a/R/convert.R b/R/convert.R index 133ee7fa..e6c11aa1 100644 --- a/R/convert.R +++ b/R/convert.R @@ -38,7 +38,7 @@ convert_dt_m <- function(x) { z <- x / 12 # divide by 12 to create years mth <- x %% 12 + 1 yr <- 1960 + floor(z) - + z <- ifelse(is.na(z), NA, paste0(yr, "-", mth, "-1")) z <- as.Date(z, "%Y-%m-%d") z @@ -50,13 +50,13 @@ convert_dt_m <- function(x) { # @param x element to be converted # @author Jan Marvin Garbuszus \email{jan.garbuszus@@ruhr-uni-bochum.de} # @author Sebastian Jeworutzki \email{sebastian.jeworutzki@@ruhr-uni-bochum.de} -convert_dt_q <- function(x) { - z <- x / 4 +convert_dt_q <- function(x) { + z <- x / 4 yr <- 1960 + floor(z) - + qrt <- x %% 4 + 1 qrt_month <- c(1, 4, 7, 10) - + z <- ifelse(is.na(z), NA, paste0(yr, "-", qrt_month[qrt], "-1")) z <- as.Date(z, "%Y-%m-%d") z diff --git a/R/dbcal.R b/R/dbcal.R index c7976ca1..8b6d0f30 100644 --- a/R/dbcal.R +++ b/R/dbcal.R @@ -48,7 +48,8 @@ stbcal <- function(stbcalfile) { # Otherwise localised dates will be used. - lct <- Sys.getlocale("LC_TIME"); Sys.setlocale("LC_TIME", "C") + lct <- Sys.getlocale("LC_TIME") + Sys.setlocale("LC_TIME", "C") # Parse full file stbcal <- file(stbcalfile, "rb") @@ -56,17 +57,17 @@ stbcal <- function(stbcalfile) { close(stbcal) # Dateformat can be ymd, ydm, myd, mdy, dym or dmy - if(any(grepl("dateformat ymd", x))) + if (any(grepl("dateformat ymd", x))) dateformat <- "%Y%b%d" - if(any(grepl("dateformat ydm", x))) + if (any(grepl("dateformat ydm", x))) dateformat <- "%Y%d%b" - if(any(grepl("dateformat myd", x))) + if (any(grepl("dateformat myd", x))) dateformat <- "%b%Y%d" - if(any(grepl("dateformat mdy", x))) + if (any(grepl("dateformat mdy", x))) dateformat <- "%b%d%Y" - if(any(grepl("dateformat dym", x))) + if (any(grepl("dateformat dym", x))) dateformat <- "%b%Y%d" - if(any(grepl("dateformat dmy", x))) + if (any(grepl("dateformat dmy", x))) dateformat <- "%d%b%Y" # Range of stbcal. Range is required, contains start and end. @@ -75,39 +76,39 @@ stbcal <- function(stbcalfile) { range <- strsplit(range, " ") rangestart <- range[[1]][2] rangestop <- range[[1]][3] - range <- seq(from= as.Date(rangestart, dateformat), - to= as.Date(rangestop, dateformat), "days") + range <- seq(from = as.Date(rangestart, dateformat), + to = as.Date(rangestop, dateformat), "days") # Centerdate of stbcal. Date that matches 0. centerpos <- grep("centerdate", x) centerdate <- x[centerpos] - centerdate <- gsub("centerdate ","",centerdate) + centerdate <- gsub("centerdate ", "", centerdate) centerdate <- as.Date(centerdate, dateformat) # Omit Dayofweek - omitdayofweekpos <- grep ("omit dayofweek", x) + omitdayofweekpos <- grep("omit dayofweek", x) omitdayofweek <- x[omitdayofweekpos] # Mo, Tu, We, Th, Fr, Sa, Su daysofweek <- weekdays(as.Date(range)) - stbcal <- data.frame(range = range, daysofweek=daysofweek) + stbcal <- data.frame(range = range, daysofweek = daysofweek) # Weekdays every week if (any(grepl("Mo", omitdayofweek))) - stbcal$daysofweek[stbcal$daysofweek=="Monday"] <- NA + stbcal$daysofweek[stbcal$daysofweek == "Monday"] <- NA if (any(grepl("Tu", omitdayofweek))) - stbcal$daysofweek[stbcal$daysofweek=="Tuesday"] <- NA + stbcal$daysofweek[stbcal$daysofweek == "Tuesday"] <- NA if (any(grepl("We", omitdayofweek))) - stbcal$daysofweek[stbcal$daysofweek=="Wednesday"] <- NA + stbcal$daysofweek[stbcal$daysofweek == "Wednesday"] <- NA if (any(grepl("Th", omitdayofweek))) - stbcal$daysofweek[stbcal$daysofweek=="Thursday"] <- NA + stbcal$daysofweek[stbcal$daysofweek == "Thursday"] <- NA if (any(grepl("Fr", omitdayofweek))) - stbcal$daysofweek[stbcal$daysofweek=="Friday"] <- NA + stbcal$daysofweek[stbcal$daysofweek == "Friday"] <- NA if (any(grepl("Sa", omitdayofweek))) - stbcal$daysofweek[stbcal$daysofweek=="Saturday"] <- NA + stbcal$daysofweek[stbcal$daysofweek == "Saturday"] <- NA if (any(grepl("Su", omitdayofweek))) - stbcal$daysofweek[stbcal$daysofweek=="Sunday"] <- NA + stbcal$daysofweek[stbcal$daysofweek == "Sunday"] <- NA # Special days to be omitted if (any(grepl("omit date", x))) { @@ -117,21 +118,21 @@ stbcal <- function(stbcalfile) { omitdates <- gsub("omit date ", "", omitdates) dates <- as.Date(omitdates, dateformat) - stbcal$daysofweek[which(stbcal$range%in%dates)] <- NA + stbcal$daysofweek[which(stbcal$range %in% dates)] <- NA # Keep only wanted days stbcal$daysofweek behalten - stbcal <- stbcal[complete.cases(stbcal$daysofweek),] + stbcal <- stbcal[complete.cases(stbcal$daysofweek), ] } # In case centerdate is not rangestart: stbcal$buisdays <- NA - stbcal$buisdays[stbcal$range==centerdate] <- 0 - stbcal$buisdays[stbcal$rangecenterdate] <- seq( - from=1, - to=length(stbcal$range[stbcal$range>centerdate])) + stbcal$buisdays[stbcal$range == centerdate] <- 0 + stbcal$buisdays[stbcal$range < centerdate] <- seq( + from = -length(stbcal$range[stbcal$range < centerdate]), + to = -1) + stbcal$buisdays[stbcal$range > centerdate] <- seq( + from = 1, + to = length(stbcal$range[stbcal$range > centerdate])) # Add purpose if (any(grepl("purpose", x))) { @@ -165,11 +166,11 @@ stbcal <- function(stbcalfile) { #' dat$ldatescal2 <- as.caldays(dat$ldate, sp500) #' all(dat$ldatescal2==dat$ldatescal) #' @export -as.caldays <- function(buisdays, cal, format="%Y-%m-%d") { +as.caldays <- function(buisdays, cal, format = "%Y-%m-%d") { rownames(cal) <- cal$buisdays dates <- cal[as.character(buisdays), "range"] - if(!is.null(format)) + if (!is.null(format)) as.Date(dates, format = format) return(dates) } diff --git a/R/read.R b/R/read.R index 6246f1d3..4c08fc3b 100644 --- a/R/read.R +++ b/R/read.R @@ -141,8 +141,8 @@ #' @importFrom utils download.file #' @importFrom stats na.omit #' @export -read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, - encoding = "UTF-8", fromEncoding=NULL, +read.dta13 <- function(file, convert.factors = TRUE, generate.factors = FALSE, + encoding = "UTF-8", fromEncoding = NULL, convert.underscore = FALSE, missing.type = FALSE, convert.dates = TRUE, replace.strl = TRUE, add.rownames = FALSE, nonint.factors = FALSE, @@ -170,11 +170,11 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, # some select.row checks if (!is.null(select.rows)) { # check that it is a numeric - if (!is.numeric(select.rows)){ + if (!is.numeric(select.rows)) { return(message("select.rows must be of type numeric")) } else { # guard against negative values - if (any(select.rows < 0) ) + if (any(select.rows < 0)) select.rows <- abs(select.rows) # check that length is not > 2 @@ -190,11 +190,11 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, select.rows <- c(select.rows[2], select.rows[1]) # make sure to start at index position 1 if select.rows[2] > 0 - if (select.rows[2] > 0 & select.rows[1] == 0) + if (select.rows[2] > 0 && select.rows[1] == 0) select.rows[1] <- 1 } else { # set a value - select.rows <- c(0,0) + select.rows <- c(0, 0) } select.cols_chr <- as.character(NA) @@ -207,7 +207,7 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, select.cols_chr <- select.cols # do we need factor too? - if (is.numeric(select.cols) | is.integer(select.cols)) + if (is.numeric(select.cols) || is.integer(select.cols)) select.cols_int <- select.cols } @@ -219,11 +219,11 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, sstr <- 2045 sstrl <- 32768 - salias <- 65525 + # salias <- 65525 sdouble <- 65526 sfloat <- 65527 - slong <- 65528 - sint <- 65529 + # slong <- 65528 + # sint <- 65529 sbyte <- 65530 if (version < 117) { @@ -231,8 +231,8 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, sstrl <- 255 sdouble <- 255 sfloat <- 254 - slong <- 253 - sint <- 252 + # slong <- 253 + # sint <- 252 sbyte <- 251 } @@ -249,13 +249,13 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, inc = c(1, 1, 1, 2 ^ 115, 2 ^ 1011) ) - if (version >= 113L & version < 117L) { + if (version >= 113L && version < 117L) { missings <- vector("list", length(data)) names(missings) <- names(data) for (v in which(types > 250L)) { this.type <- types[v] - 250L nas <- is.na(data[[v]]) | data[[v]] >= stata.na$min[this.type] - natype <- (data[[v]][nas] - stata.na$min[this.type])/ + natype <- (data[[v]][nas] - stata.na$min[this.type]) / stata.na$inc[this.type] natype[is.na(natype)] <- 0L missings[[v]] <- rep(NA, NROW(data)) @@ -278,8 +278,9 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, data[[v]][nas] <- NA } attr(data, "missing") <- missings - } else + } else { warning("'missing.type' only applicable to version >= 8 files") + } } } @@ -287,12 +288,12 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, datalabel <- attr(data, "data.label") ## Encoding - if(!is.null(encoding)) { + if (!is.null(encoding)) { # set from encoding by dta version - if(is.null(fromEncoding)) { + if (is.null(fromEncoding)) { fromEncoding <- "CP1252" - if(attr(data, "version") >= 118L) + if (attr(data, "version") >= 118L) fromEncoding <- "UTF-8" } @@ -314,7 +315,7 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, names(label) <- read.encoding(names(label), fromEncoding, encoding) if (length(label) > 0) { - for (i in 1:length(label)) { + for (i in seq_along(label)) { names(label[[i]]) <- read.encoding(names(label[[i]]), fromEncoding, encoding) } @@ -322,15 +323,18 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, } # recode character variables - for (v in (1:ncol(data))[types <= sstr]) { - data[, v] <- iconv(data[, v], from=fromEncoding, to=encoding, sub="byte") + for (v in seq_along(data)[types <= sstr]) { + data[, v] <- iconv(data[, v], + from = fromEncoding, + to = encoding, + sub = "byte") } # expansion.field efi <- attr(data, "expansion.fields") if (length(efi) > 0) { efiChar <- unlist(lapply(efi, is.character)) - for (i in (1:length(efi))[efiChar]) { + for (i in seq_along(efi)[efiChar]) { efi[[i]] <- read.encoding(efi[[i]], fromEncoding, encoding) } attr(data, "expansion.fields") <- efi @@ -340,7 +344,7 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, #strl strl <- attr(data, "strl") if (length(strl) > 0) { - for (i in 1:length(strl)) { + for (i in seq_along(strl)) { strl[[i]] <- read.encoding(strl[[i]], fromEncoding, encoding) } attr(data, "strl") <- strl @@ -350,12 +354,12 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, var.labels <- attr(data, "var.labels") - if (replace.strl & version >= 117L) { + if (replace.strl && version >= 117L) { strl <- c("") names(strl) <- "00000000000000000000" - strl <- c(strl, attr(data,"strl")) - for (j in seq(ncol(data))[types == sstrl] ) { - data[, j] <- strl[data[,j]] + strl <- c(strl, attr(data, "strl")) + for (j in seq_len(ncol(data))[types == sstrl]) { + data[, j] <- strl[data[, j]] } # if strls are in data.frame remove attribute strl attr(data, "strl") <- NULL @@ -393,8 +397,8 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, labtable <- label[[labname]] #don't convert columns of type double or float to factor if (labname %in% names(label)) { - if((vartype == sdouble | vartype == sfloat)) { - if(!nonint.factors) { + if ((vartype == sdouble || vartype == sfloat)) { + if (!nonint.factors) { # collect variables which need a warning collected_warnings[["floatfact"]] <- c(collected_warnings[["floatfact"]], vnames[i]) @@ -406,7 +410,7 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, #check for duplicated labels labcount <- table(names(labtable)) - if(any(labcount > 1)) { + if (any(labcount > 1)) { # collect variables which need a warning collected_warnings[["dublifact"]] <- c(collected_warnings[["dublifact"]], vnames[i]) @@ -420,19 +424,19 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, # assign label if label set is complete if (all(varunique %in% labtable)) { - data[, i] <- factor(data[, i], levels=labtable, - labels=names(labtable)) + data[, i] <- factor(data[, i], levels = labtable, + labels = names(labtable)) # else generate labels from codes } else if (generate.factors) { names(varunique) <- varunique gen.lab <- sort(c(varunique[!varunique %in% labtable], labtable)) - data[, i] <- factor(data[, i], levels=gen.lab, - labels=names(gen.lab)) + data[, i] <- factor(data[, i], levels = gen.lab, + labels = names(gen.lab)) # add generated labels to label.table - gen.lab.name <- paste0("gen_",vnames[i]) + gen.lab.name <- paste0("gen_", vnames[i]) attr(data, "label.table")[[gen.lab.name]] <- gen.lab attr(data, "val.labels")[i] <- gen.lab.name @@ -452,7 +456,7 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, ## issue warnings #dublifact - if(length(collected_warnings[["dublifact"]]) > 0) { + if (length(collected_warnings[["dublifact"]]) > 0) { dublifactvars <- paste(collected_warnings[["dublifact"]], collapse = ", ") warning(paste0("\n Duplicated factor levels for variables\n\n", @@ -464,7 +468,7 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, } # floatfact - if(length(collected_warnings[["floatfact"]]) > 0) { + if (length(collected_warnings[["floatfact"]]) > 0) { floatfactvars <- paste(collected_warnings[["floatfact"]], collapse = ", ") @@ -477,7 +481,7 @@ read.dta13 <- function(file, convert.factors = TRUE, generate.factors=FALSE, "\n Set option 'nonint.factors = TRUE' to assign labels anyway.\n")) } # misslab - if(length(collected_warnings[["misslab"]]) > 0) { + if (length(collected_warnings[["misslab"]]) > 0) { misslabvars <- paste(collected_warnings[["misslab"]], collapse = ", ") diff --git a/R/save.R b/R/save.R index e90e390c..883db11a 100644 --- a/R/save.R +++ b/R/save.R @@ -73,10 +73,10 @@ #' @author Sebastian Jeworutzki \email{sebastian.jeworutzki@@ruhr-uni-bochum.de} #' @useDynLib readstata13, .registration = TRUE #' @export -save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, - convert.factors=TRUE, convert.dates=TRUE, tz="GMT", - add.rownames=FALSE, compress=FALSE, version=117, - convert.underscore=FALSE){ +save.dta13 <- function(data, file, data.label = NULL, time.stamp = TRUE, + convert.factors = TRUE, convert.dates = TRUE, tz = "GMT", + add.rownames = FALSE, compress = FALSE, version = 117, + convert.underscore = FALSE) { if (!is.data.frame(data)) @@ -85,26 +85,26 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, stop("Path is invalid. Possibly a non-existing directory.") # Allow writing version as Stata version not Stata format - if (version=="15mp" | version=="16mp") + if (version == "15mp" || version == "16mp") version <- 119 - if (version==15L | version==16L) + if (version == 15L || version == 16L) version <- 118 - if (version==14L) + if (version == 14L) version <- 118 - if (version==13L) + if (version == 13L) version <- 117 - if (version==12L) + if (version == 12L) version <- 115 - if (version==11L | version==10L) + if (version == 11L || version == 10L) version <- 114 - if (version==9L | version==8L) + if (version == 9L || version == 8L) version <- 113 - if (version==7) + if (version == 7) version <- 110 - if (version==6) + if (version == 6) version <- 108 - if (version<102 | version == 109 | version == 116 | version>121) + if (version < 102 || version == 109 || version == 116 || version > 121) stop("Version mismatch abort execution. No Data was saved.") sstr <- 2045 @@ -124,18 +124,18 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, sint <- 252 sbyte <- 251 } - if (version<111 | version==112) + if (version < 111 || version == 112) sstrl <- 80 - if(!is.data.frame(data)) { + if (!is.data.frame(data)) { stop("Object is not of class data.frame.") } - + is_utf8 <- l10n_info()[["UTF-8"]] # Is recoding necessary? - if (version<=117) { + if (version <= 117) { # Reencoding is always needed doRecode <- TRUE toEncoding <- "CP1252" @@ -153,18 +153,18 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, if (doRecode) { rwn <- save.encoding(rownames(data), toEncoding) } else { - rwn <-rownames(data) + rwn <- rownames(data) } - data <- data.frame(rownames= rwn, - data, stringsAsFactors = F) + data <- data.frame(rownames = rwn, + data, stringsAsFactors = FALSE) } rownames(data) <- NULL if (convert.underscore) { names(data) <- gsub("[^a-zA-Z0-9_]", "_", names(data)) names(data)[grepl("^[0-9]", names(data))] <- - paste0( "_", names(data)[grepl("^[0-9]", names(data))]) + paste0("_", names(data)[grepl("^[0-9]", names(data))]) } filepath <- path.expand(file) @@ -179,7 +179,7 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, vartypen <- vtyp <- sapply(data, class) # Identify POSIXt - posix_datetime <- which(sapply(data, + posix_datetime <- which(sapply(data, function(x) inherits(x, "POSIXt"))) vartypen[posix_datetime] <- vtyp[posix_datetime] <- "POSIXt" @@ -187,9 +187,9 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, # times: seconds from 1970-01-01 + 10 years (new origin 1960-01-01) * 1000 = miliseconds # go back 1h for (v in names(vartypen[vartypen == "POSIXt"])) - data[[v]] <- (as.double(data[[v]]) + 315622800 - 60*60)*1000 + data[[v]] <- (as.double(data[[v]]) + 315622800 - 60 * 60) * 1000 - if (convert.factors){ + if (convert.factors) { if (version < 106) { hasfactors <- sapply(data, is.factor) @@ -200,7 +200,7 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, } # If our data.frame contains factors, we create a label.table factors <- which(sapply(data, is.factor)) - f.names <- attr(factors,"names") + f.names <- attr(factors, "names") label.table <- vector("list", length(f.names)) names(label.table) <- f.names @@ -219,7 +219,7 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, f.labels <- as.integer(labels(levels(data[[v]]))) attr(f.labels, "names") <- f.levels f.labels <- f.labels[names(f.labels) != ".."] - label.table[[ (f.names[i]) ]] <- f.labels + label.table[[(f.names[i])]] <- f.labels valLabel[v] <- f.names[i] } @@ -230,7 +230,7 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, attr(data, "vallabels") <- valLabel } else { attr(data, "label.table") <- NULL - attr(data, "vallabels") <- rep("",length(data)) + attr(data, "vallabels") <- rep("", length(data)) } if (convert.dates) { @@ -239,7 +239,7 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, ) for (v in dates) data[[v]] <- as.vector( - julian(data[[v]],as.Date("1960-1-1", tz = "GMT")) + julian(data[[v]], as.Date("1960-1-1", tz = "GMT")) ) } @@ -259,12 +259,14 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, vartypen[ddates] <- -sdouble vartypen[empty] <- sbyte } else { - varTmin <- sapply(data[(ff | ii) & !empty], function(x) min(x,na.rm=TRUE)) - varTmax <- sapply(data[(ff | ii) & !empty], function(x) max(x,na.rm=TRUE)) + varTmin <- sapply(data[(ff | ii) & !empty], + function(x) min(x, na.rm = TRUE)) + varTmax <- sapply(data[(ff | ii) & !empty], + function(x) max(x, na.rm = TRUE)) # check if numerics can be stored as integers numToCompress <- sapply(data[ff], saveToExport) - + if (any(numToCompress)) { saveToConvert <- names(data[ff])[numToCompress] # replace numerics as integers @@ -277,8 +279,10 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, vartypen[ff] <- sdouble - bmin <- -127; bmax <- 100 - imin <- -32767; imax <- 32740 + bmin <- -127 + bmax <- 100 + imin <- -32767 + imax <- 32740 # check if integer is byte, int or long for (k in names(which(ii & !empty))) { vartypen[k][varTmin[k] < imin | varTmax[k] > imax] <- slong @@ -300,20 +304,19 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, } # recode character variables. >118 wants utf-8, so encoding may be required - if(doRecode) { + if (doRecode) { #TODO: use seq_len ? - for(v in (1:ncol(data))[vartypen == "character"]) { + for (v in seq_len(ncol(data))[vartypen == "character"]) { data[, v] <- save.encoding(data[, v], toEncoding) } } # str and strL are stored by maximum length of chars in a variable - str.length <- sapply(data[vartypen == "character"], FUN=maxchar) + str.length <- sapply(data[vartypen == "character"], FUN = maxchar) str.length[str.length > sstr] <- sstrl # vartypen for character - for (v in names(vartypen[vartypen == "character"])) - { + for (v in names(vartypen[vartypen == "character"])) { # str.length[str.length > sstr] <- sstrl # no loop necessary! vartypen[[v]] <- str.length[[v]] @@ -341,9 +344,9 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, maxlen <- 8 if (version >= 118) maxlen <- 128 - - if (any (lenvarnames > maxlen)) { - message ("Varname to long. Resizing. Max size is ", maxlen, ".") + + if (any(lenvarnames > maxlen)) { + message("Varname to long. Resizing. Max size is ", maxlen, ".") names(data) <- sapply(varnames, strtrim, width = maxlen) } @@ -378,14 +381,15 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, if (!time.stamp) { attr(data, "timestamp") <- "" } else { - lct <- Sys.getlocale("LC_TIME"); Sys.setlocale("LC_TIME", "C") + lct <- Sys.getlocale("LC_TIME") + Sys.setlocale("LC_TIME", "C") attr(data, "timestamp") <- format(Sys.time(), "%d %b %Y %H:%M") - Sys.setlocale("LC_TIME",lct) + Sys.setlocale("LC_TIME", lct) } expfield <- attr(data, "expansion.fields") if (doRecode) { - expfield <- lapply(expfield, function(x) iconv(x, to=toEncoding)) + expfield <- lapply(expfield, function(x) iconv(x, to = toEncoding)) } attr(data, "expansion.fields") <- rev(expfield) @@ -406,8 +410,8 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, if (doRecode) { attr(data, "var.labels") <- save.encoding(varlabels, toEncoding) - } - if (!is.null(varlabels) & (length(varlabels)!=ncol(data))) { + } + if (!is.null(varlabels) && (length(varlabels) != ncol(data))) { attr(data, "var.labels") <- NULL warning("Number of variable labels does not match number of variables. Variable labels dropped.") @@ -415,7 +419,7 @@ save.dta13 <- function(data, file, data.label=NULL, time.stamp=TRUE, if (version >= 117) - invisible( stata_save(filePath = filepath, dat = data) ) + invisible(stata_save(filePath = filepath, dat = data)) else - invisible( stata_pre13_save(filePath = filepath, dat = data) ) + invisible(stata_pre13_save(filePath = filepath, dat = data)) } diff --git a/R/tools.R b/R/tools.R index 3b4b1853..e5f89bbb 100644 --- a/R/tools.R +++ b/R/tools.R @@ -22,27 +22,28 @@ # @author Sebastian Jeworutzki \email{sebastian.jeworutzki@@ruhr-uni-bochum.de} read.encoding <- function(x, fromEncoding, encoding) { iconv(x, - from=fromEncoding, - to=encoding , - sub="byte") + from = fromEncoding, + to = encoding, + sub = "byte") } save.encoding <- function(x, encoding) { - sapply(x, function(s) - ifelse(Encoding(s) == "unknown", - iconv(s, - to=encoding, - sub="byte"), - iconv(s, from=Encoding(s), - to=encoding, - sub="byte") - ) - ) + sapply(x, function(s) { + ifelse(Encoding(s) == "unknown", + iconv(s, + to = encoding, + sub = "byte"), + iconv(s, from = Encoding(s), + to = encoding, + sub = "byte") + ) + } + ) } # Function to check if directory exists # @param x file path -dir.exists13 <-function(x) { +dir.exists13 <- function(x) { path <- dirname(x) return(file.exists(path)) } @@ -52,7 +53,7 @@ dir.exists13 <-function(x) { # @param path path to dta file # @author Jan Marvin Garbuszus \email{jan.garbuszus@@ruhr-uni-bochum.de} # @author Sebastian Jeworutzki \email{sebastian.jeworutzki@@ruhr-uni-bochum.de} -get.filepath <- function(path="") { +get.filepath <- function(path = "") { if (substring(path, 1, 1) == "~") { filepath <- path.expand(path) } else { @@ -83,7 +84,7 @@ get.filepath <- function(path="") { #' @author Jan Marvin Garbuszus \email{jan.garbuszus@@ruhr-uni-bochum.de} #' @author Sebastian Jeworutzki \email{sebastian.jeworutzki@@ruhr-uni-bochum.de} #' @export -get.lang <- function(dat, print=T) { +get.lang <- function(dat, print = TRUE) { ex <- attr(dat, "expansion.fields") lang <- list() @@ -100,7 +101,7 @@ get.lang <- function(dat, print=T) { cat("Available languages:\n ") cat(paste0(lang$languages, "\n")) cat("\nDefault language:\n") - cat(paste0(" ",lang$default, "\n")) + cat(paste0(" ", lang$default, "\n")) return(invisible(lang)) } @@ -123,9 +124,9 @@ get.lang <- function(dat, print=T) { #' @author Jan Marvin Garbuszus \email{jan.garbuszus@@ruhr-uni-bochum.de} #' @author Sebastian Jeworutzki \email{sebastian.jeworutzki@@ruhr-uni-bochum.de} #' @export -get.label.name <- function(dat, var.name=NULL, lang=NA) { +get.label.name <- function(dat, var.name = NULL, lang = NA) { vnames <- names(dat) - if (is.na(lang) | lang == get.lang(dat, F)$default) { + if (is.na(lang) || lang == get.lang(dat, FALSE)$default) { labelsets <- attr(dat, "val.labels") names(labelsets) <- vnames } else if (is.character(lang)) { @@ -133,7 +134,7 @@ get.label.name <- function(dat, var.name=NULL, lang=NA) { has_no_label_lang <- identical( integer(0), - unlist(lapply(ex, grep, pattern ="_lang_l_")) + unlist(lapply(ex, grep, pattern = "_lang_l_")) ) if (has_no_label_lang) { @@ -252,12 +253,12 @@ get.label.tables <- function(dat) { #' # German label #' set.label(dat, "type", "de") #' @export -set.label <- function(dat, var.name, lang=NA) { - if (is.factor(dat[,var.name])) { - tmp <- get.origin.codes(dat[,var.name], +set.label <- function(dat, var.name, lang = NA) { + if (is.factor(dat[, var.name])) { + tmp <- get.origin.codes(dat[, var.name], get.label(dat, get.label.name(dat, var.name))) } else { - tmp <- dat[,var.name] + tmp <- dat[, var.name] } labtable <- get.label(dat, get.label.name(dat, var.name, lang)) @@ -267,7 +268,7 @@ set.label <- function(dat, var.name, lang=NA) { if (any(labcount > 1)) { - warning(paste0("\n ",var.name, ":\n Duplicated factor levels detected -", + warning(paste0("\n ", var.name, ":\n Duplicated factor levels detected -", "generating unique labels.\n")) labdups <- names(labtable) %in% names(labcount[labcount > 1]) # generate unique labels from assigned label and code number @@ -275,8 +276,8 @@ set.label <- function(dat, var.name, lang=NA) { labtable[labdups], ")") } - return(factor(tmp, levels=labtable, - labels=names(labtable)) + return(factor(tmp, levels = labtable, + labels = names(labtable)) ) } @@ -301,15 +302,15 @@ set.label <- function(dat, var.name, lang=NA) { #' dat <- read.dta13(system.file("extdata/statacar.dta", package="readstata13"), #' convert.factors=FALSE) #' -#' # display variable labels +#' # display variable labels #' varlabel(dat) -#' +#' #' # display german variable labels #' varlabel(dat, lang="de") -#' +#' #' # display german variable label for brand #' varlabel(dat, var.name = "brand", lang="de") -#' +#' #' # define new variable labels #' varlabel(dat) <- letters[1:ncol(dat)] #' @@ -319,9 +320,9 @@ NULL #' @rdname varlabel #' @export -varlabel <- function(dat, var.name=NULL, lang=NA) { +varlabel <- function(dat, var.name = NULL, lang = NA) { vnames <- names(dat) - if (is.na(lang) | lang == get.lang(dat, F)$default) { + if (is.na(lang) || lang == get.lang(dat, FALSE)$default) { varlabel <- attr(dat, "var.labels") names(varlabel) <- vnames } else if (is.character(lang)) { @@ -342,7 +343,7 @@ varlabel <- function(dat, var.name=NULL, lang=NA) { #' @export 'varlabel<-' <- function(dat, value) { nlabs <- ncol(dat) - if (length(value)==nlabs) { + if (length(value) == nlabs) { attr(dat, "var.labels") <- value } else { warning(paste("Vector of new labels must have", nlabs, "entries.")) @@ -353,7 +354,7 @@ varlabel <- function(dat, var.name=NULL, lang=NA) { #' Assign Stata Language Labels #' -#' Changes default label language for a dataset. +#' Changes default label language for a dataset. #' Variables with generated labels (option generate.labels=TRUE) are kept unchanged. #' #' @param dat \emph{data.frame.} Data.frame created by \code{read.dta13}. @@ -376,29 +377,29 @@ varlabel <- function(dat, var.name=NULL, lang=NA) { #' @importFrom stats na.omit #' @importFrom utils txtProgressBar setTxtProgressBar #' @export -set.lang <- function(dat, lang=NA, generate.factors=FALSE) { - if (is.na(lang) | lang == get.lang(dat, F)$default) { +set.lang <- function(dat, lang = NA, generate.factors = FALSE) { + if (is.na(lang) || lang == get.lang(dat, FALSE)$default) { return(dat) } else if (is.character(lang)) { vnames <- names(dat) - types <- attr(dat, "types") + # types <- attr(dat, "types") label <- attr(dat, "label.table") val.labels <- get.label.name(dat, NULL, lang) oldval.labels <- get.label.name(dat) oldval.labels <- oldval.labels[!is.na(oldval.labels)] oldval.labtab <- lapply(oldval.labels, function(x) get.label(dat, x)) - oldlang <- get.lang(dat, F)$default + oldlang <- get.lang(dat, FALSE)$default cat("Replacing value labels. This might take some time...\n") - pb <- txtProgressBar(min=1,max=length(val.labels)+1) + pb <- txtProgressBar(min = 1, max = length(val.labels) + 1) for (i in which(val.labels != "")) { labname <- val.labels[i] - vartype <- types[i] + # vartype <- types[i] labtable <- label[[labname]] varname <- names(val.labels)[i] @@ -406,27 +407,27 @@ set.lang <- function(dat, lang=NA, generate.factors=FALSE) { if (is.factor(dat[, varname])) { oldlabname <- oldval.labels[names(oldval.labels) == varname] oldlabtab <- oldval.labtab[[names(oldlabname)]] - codes <- get.origin.codes(dat[,varname], oldlabtab) + codes <- get.origin.codes(dat[, varname], oldlabtab) varunique <- na.omit(unique(codes)) } else { - varunique <- na.omit(unique(dat[,varname])) + varunique <- na.omit(unique(dat[, varname])) } - if (labname %in% names(label) & is.factor(dat[,varname])) { - + if (labname %in% names(label) && is.factor(dat[, varname])) { + # assign label if label set is complete if (all(varunique %in% labtable)) { - dat[,varname] <- factor(codes, levels=labtable, - labels=names(labtable)) + dat[, varname] <- factor(codes, levels = labtable, + labels = names(labtable)) } # else generate labels from codes } else if (generate.factors) { names(varunique) <- as.character(varunique) gen.lab <- sort(c(varunique[!varunique %in% labtable], labtable)) - dat[,varname] <- factor(codes, levels=gen.lab, - labels=names(gen.lab)) + dat[, varname] <- factor(codes, levels = gen.lab, + labels = names(gen.lab)) } else { warning(paste(vnames[i], "Missing factor labels - no labels assigned. Set option generate.factors=T to generate labels.")) @@ -442,17 +443,17 @@ set.lang <- function(dat, lang=NA, generate.factors=FALSE) { names(oldval.labels) <- NULL tmp <- list() for (i in seq_along(val.labels)) { - tmp[[i]] <- c(vnames[i],paste0("_lang_l_",oldlang), oldval.labels[i]) + tmp[[i]] <- c(vnames[i], paste0("_lang_l_", oldlang), oldval.labels[i]) } - attr(dat, "expansion.fields") <- c(attr(dat, "expansion.fields"),tmp) + attr(dat, "expansion.fields") <- c(attr(dat, "expansion.fields"), tmp) # variable label old.varlabel <- attr(dat, "var.labels") tmp <- list() for (i in seq_along(old.varlabel)) { - tmp[[i]] <- c(vnames[i],paste0("_lang_v_", oldlang), old.varlabel[i]) + tmp[[i]] <- c(vnames[i], paste0("_lang_v_", oldlang), old.varlabel[i]) } - attr(dat, "expansion.fields") <- c(attr(dat, "expansion.fields"),tmp) + attr(dat, "expansion.fields") <- c(attr(dat, "expansion.fields"), tmp) ex <- attr(dat, "expansion.fields") varname <- sapply(ex[grep(paste0("_lang_v_", lang), ex)], function(x) x[1]) @@ -480,8 +481,8 @@ set.lang <- function(dat, lang=NA, generate.factors=FALSE) { #' #' @param x vector of data frame saveToExport <- function(x) { - ifelse(any(is.infinite(x)), FALSE, - ifelse(any(!is.na(x) & (x > .Machine$integer.max | x < -.Machine$integer.max)), FALSE, + ifelse(any(is.infinite(x)), FALSE, + ifelse(any(!is.na(x) & (x > .Machine$integer.max | x < -.Machine$integer.max)), FALSE, isTRUE(all.equal(x, as.integer(x))))) } @@ -501,10 +502,10 @@ saveToExport <- function(x) { #' #' @param x vector of data frame maxchar <- function(x) { - z <- max(nchar(x, type="byte"), na.rm = TRUE) + z <- max(nchar(x, type = "byte"), na.rm = TRUE) # Stata does not allow storing a string of size 0 - if (is.infinite(z) | (z == 0)) + if (is.infinite(z) || (z == 0)) z <- 1 z diff --git a/man/get.lang.Rd b/man/get.lang.Rd index 11be34c9..b9de4aa3 100644 --- a/man/get.lang.Rd +++ b/man/get.lang.Rd @@ -4,7 +4,7 @@ \alias{get.lang} \title{Show Default Label Language} \usage{ -get.lang(dat, print = T) +get.lang(dat, print = TRUE) } \arguments{ \item{dat}{\emph{data.frame.} Data.frame created by \code{read.dta13}.} diff --git a/man/set.lang.Rd b/man/set.lang.Rd index 1f615718..76a7b39f 100644 --- a/man/set.lang.Rd +++ b/man/set.lang.Rd @@ -19,7 +19,7 @@ are generated.} Returns a data.frame with value labels in language "lang". } \description{ -Changes default label language for a dataset. +Changes default label language for a dataset. Variables with generated labels (option generate.labels=TRUE) are kept unchanged. } \examples{ diff --git a/man/varlabel.Rd b/man/varlabel.Rd index 1a902970..69390318 100644 --- a/man/varlabel.Rd +++ b/man/varlabel.Rd @@ -31,7 +31,7 @@ Retrieve or set variable labels for a dataset. dat <- read.dta13(system.file("extdata/statacar.dta", package="readstata13"), convert.factors=FALSE) -# display variable labels +# display variable labels varlabel(dat) # display german variable labels diff --git a/tests/testthat/test_read.R b/tests/testthat/test_read.R index 4f66c9f1..b4cfb576 100644 --- a/tests/testthat/test_read.R +++ b/tests/testthat/test_read.R @@ -22,7 +22,7 @@ datacompare <- function(x, y) { dd <- data.frame(missings = as.numeric(rep(NA, 27))) -missings <- system.file("extdata", "missings.dta", package="readstata13") +missings <- system.file("extdata", "missings.dta", package = "readstata13") @@ -41,16 +41,16 @@ test_that("missings", { # rm(list = files) #### missings msf/lsf #### -dd <- data.frame(b = as.logical(c(1,NA)), - i=as.integer(c(1,NA)), - n=as.numeric(c(1,NA)), - s=c("1", ""), +dd <- data.frame(b = as.logical(c(1, NA)), + i = as.integer(c(1, NA)), + n = as.numeric(c(1, NA)), + s = c("1", ""), stringsAsFactors = FALSE) dd$b <- as.integer(dd$b) -missings_msf <- system.file("extdata", "missings_msf.dta", package="readstata13") -missings_lsf <- system.file("extdata", "missings_lsf.dta", package="readstata13") +missings_msf <- system.file("extdata", "missings_msf.dta", package = "readstata13") +missings_lsf <- system.file("extdata", "missings_lsf.dta", package = "readstata13") dd_msf <- read.dta13(missings_msf) dd_lsf <- read.dta13(missings_lsf) @@ -67,7 +67,7 @@ test_that("missings msf/lsf", { dd <- data.frame(v1 = as.numeric(1:2)) dd$v1 <- factor(x = dd$v1, levels = 1:2, labels = c("one", "2")) -gen_fac <- system.file("extdata", "gen_fac.dta", package="readstata13") +gen_fac <- system.file("extdata", "gen_fac.dta", package = "readstata13") @@ -83,7 +83,7 @@ test_that("generate.factors TRUE", { dd <- data.frame(v1 = as.numeric(1:2)) -gen_fac <- system.file("extdata", "gen_fac.dta", package="readstata13") +gen_fac <- system.file("extdata", "gen_fac.dta", package = "readstata13") suppressWarnings(dd118 <- read.dta13(gen_fac, convert.factors = TRUE, generate.factors = FALSE)) @@ -98,9 +98,9 @@ dd <- data.frame(v.1 = as.numeric(1:2), v.2 = as.numeric(1:2), long.name.multiple.underscores = as.numeric(1:2)) -underscore <- system.file("extdata", "underscore.dta", package="readstata13") +underscore <- system.file("extdata", "underscore.dta", package = "readstata13") -dd118 <- read.dta13(underscore, convert.underscore = T) +dd118 <- read.dta13(underscore, convert.underscore = TRUE) test_that("generate.factors TRUE", { expect_true(datacompare(dd, dd118)) @@ -112,9 +112,9 @@ dd <- data.frame(v.1 = as.numeric(1:2), v.2 = as.numeric(1:2), long_name_multiple_underscores = as.numeric(1:2)) -underscore <- system.file("extdata", "underscore.dta", package="readstata13") +underscore <- system.file("extdata", "underscore.dta", package = "readstata13") -dd118 <- read.dta13(underscore, convert.underscore = F) +dd118 <- read.dta13(underscore, convert.underscore = FALSE) test_that("generate.factors TRUE", { expect_true(datacompare(dd, dd118)) @@ -126,7 +126,7 @@ test_that("generate.factors TRUE", { dd <- data.frame(v1 = as.numeric(1:2)) dd$v1 <- factor(x = dd$v1, levels = 1:2, labels = c("one", "1.2")) -nonint <- system.file("extdata", "nonint.dta", package="readstata13") +nonint <- system.file("extdata", "nonint.dta", package = "readstata13") @@ -142,24 +142,24 @@ test_that("nonint.factors TRUE", { #### encoding TRUE #### -umlauts <- c("ä","ö","ü","ß","€","Œ") +umlauts <- c("ä", "ö", "ü", "ß", "€", "Œ") Encoding(umlauts) <- "UTF-8" ddcp <- dd <- data.frame(num = factor(1:6, levels = 1:6, labels = umlauts), chr = umlauts, stringsAsFactors = FALSE) # Dataset in CP1252 -levels(ddcp$num)[5:6] <- c("EUR","OE") -ddcp$chr[5:6] <- c("EUR","OE") +levels(ddcp$num)[5:6] <- c("EUR", "OE") +ddcp$chr[5:6] <- c("EUR", "OE") # Stata 14 -encode <- system.file("extdata", "encode.dta", package="readstata13") +encode <- system.file("extdata", "encode.dta", package = "readstata13") # Stata 12 -encodecp <- system.file("extdata", "encodecp.dta", package="readstata13") +encodecp <- system.file("extdata", "encodecp.dta", package = "readstata13") ddutf_aE <- read.dta13(encode, convert.factors = TRUE, generate.factors = TRUE, - encoding="UTF-8") + encoding = "UTF-8") # On windows the last two characters will fail on default (not in latin1) dd_aE <- read.dta13(encode, convert.factors = TRUE, generate.factors = TRUE) @@ -176,24 +176,24 @@ test_that("encoding UTF-8 (Stata 14)", { }) test_that("Reading of strls", { - strl <- system.file("extdata", "statacar.dta", package="readstata13") + strl <- system.file("extdata", "statacar.dta", package = "readstata13") - ddstrlf <- read.dta13(strl, replace.strl = F) + ddstrlf <- read.dta13(strl, replace.strl = FALSE) ddstrlfref <- paste0("11_", 1:8) expect_equal(ddstrlf$modelStrL, ddstrlfref) - ddstrl <- read.dta13(strl, replace.strl = T) + ddstrl <- read.dta13(strl, replace.strl = TRUE) expect_equal(ddstrl$model, ddstrl$modelStrL) }) test_that("reading of many strls", { # slow test - N = 1e4 + N <- 1e4 big_strl <- data.frame( x = 1:N, y = sample(LETTERS, N, replace = TRUE), - z = c(paste(rep("a", 3000), collapse=""), sample(LETTERS, N-1, replace=TRUE)) + z = c(paste(rep("a", 3000), collapse = ""), sample(LETTERS, N - 1, replace = TRUE)) ) # writing the file is slow @@ -206,7 +206,7 @@ test_that("reading of many strls", { }) test_that("various datetime conversions", { - datetime <- system.file("extdata", "datetime.dta", package="readstata13") + datetime <- system.file("extdata", "datetime.dta", package = "readstata13") td <- c("2001-05-15", "1999-04-01", @@ -251,7 +251,7 @@ test_that("various datetime conversions", { test_that("reading file format 120 works", { - fl <- system.file("extdata", "myproject2.dtas", package="readstata13") + fl <- system.file("extdata", "myproject2.dtas", package = "readstata13") tmp <- tempdir() diff --git a/tests/testthat/test_save.R b/tests/testthat/test_save.R index b5873a06..02eeee36 100644 --- a/tests/testthat/test_save.R +++ b/tests/testthat/test_save.R @@ -21,7 +21,7 @@ datacompare <- function(x, y) { all(unlist(Map(all.equal, x, y))) } -namescompare <- function(x, y){ +namescompare <- function(x, y) { all(identical(names(x), names(y))) } @@ -58,7 +58,7 @@ save.dta13(dd, "data/dta_104.dta", version = 104) save.dta13(dd, "data/dta_103.dta", version = 103) save.dta13(dd, "data/dta_102.dta", version = 102) -dd15mp<- read.dta13("data/dta_15mp.dta") +dd15mp <- read.dta13("data/dta_15mp.dta") dd119 <- read.dta13("data/dta_119.dta") dd118 <- read.dta13("data/dta_118.dta") dd117 <- read.dta13("data/dta_117.dta") @@ -180,7 +180,7 @@ if (readstata13:::dir.exists13("data")) dir.create("data") dd <- mtcars -dd$am <- factor(x = dd$am, levels = c(0,1), labels = c("auto", "man")) +dd$am <- factor(x = dd$am, levels = c(0, 1), labels = c("auto", "man")) save.dta13(dd, "data/dta_121.dta", version = 121, convert.factors = TRUE) save.dta13(dd, "data/dta_120.dta", version = 120, convert.factors = TRUE) @@ -253,7 +253,7 @@ if (readstata13:::dir.exists13("data")) dir.create("data") dd <- mtcars -dd$am <- factor(x = dd$am, levels = c(0,1), labels = c("auto", "man")) +dd$am <- factor(x = dd$am, levels = c(0, 1), labels = c("auto", "man")) save.dta13(dd, "data/dta_121.dta", version = 121, convert.factors = FALSE) save.dta13(dd, "data/dta_120.dta", version = 120, convert.factors = FALSE) @@ -605,9 +605,9 @@ dir.create("data") # strLs can be of length any length up to 2 billion characters. Starting with # 2046 a string is handled as a strL -dd <- data.frame( dat = c(paste(replicate(2046, "a"), collapse = ""), - paste(replicate(2046, "b"), collapse = "")), - stringsAsFactors = FALSE) +dd <- data.frame(dat = c(paste(replicate(2046, "a"), collapse = ""), + paste(replicate(2046, "b"), collapse = "")), + stringsAsFactors = FALSE) save.dta13(dd, "data/dta_121.dta", version = 121) save.dta13(dd, "data/dta_120.dta", version = 120) @@ -812,7 +812,7 @@ dd102 <- read.dta13("data/dta_102.dta", select.rows = 5) unlink("data", recursive = TRUE) -dd <- dd[1:5,] +dd <- dd[1:5, ] test_that("select.rows = 5", { # check numerics @@ -861,28 +861,28 @@ save.dta13(dd, "data/dta_104.dta", version = 104) save.dta13(dd, "data/dta_103.dta", version = 103) save.dta13(dd, "data/dta_102.dta", version = 102) -dd121 <- read.dta13("data/dta_121.dta", select.rows = c(5,10)) -dd120 <- read.dta13("data/dta_120.dta", select.rows = c(5,10)) -dd119 <- read.dta13("data/dta_119.dta", select.rows = c(5,10)) -dd118 <- read.dta13("data/dta_118.dta", select.rows = c(5,10)) -dd117 <- read.dta13("data/dta_117.dta", select.rows = c(5,10)) -dd115 <- read.dta13("data/dta_115.dta", select.rows = c(5,10)) -dd114 <- read.dta13("data/dta_114.dta", select.rows = c(5,10)) -dd113 <- read.dta13("data/dta_113.dta", select.rows = c(5,10)) -dd112 <- read.dta13("data/dta_112.dta", select.rows = c(5,10)) -dd111 <- read.dta13("data/dta_111.dta", select.rows = c(5,10)) -dd110 <- read.dta13("data/dta_110.dta", select.rows = c(5,10)) -dd108 <- read.dta13("data/dta_108.dta", select.rows = c(5,10)) -dd107 <- read.dta13("data/dta_107.dta", select.rows = c(5,10)) -dd106 <- read.dta13("data/dta_106.dta", select.rows = c(5,10)) -dd105 <- read.dta13("data/dta_105.dta", select.rows = c(5,10)) -dd104 <- read.dta13("data/dta_104.dta", select.rows = c(5,10)) -dd103 <- read.dta13("data/dta_103.dta", select.rows = c(5,10)) -dd102 <- read.dta13("data/dta_102.dta", select.rows = c(5,10)) +dd121 <- read.dta13("data/dta_121.dta", select.rows = c(5, 10)) +dd120 <- read.dta13("data/dta_120.dta", select.rows = c(5, 10)) +dd119 <- read.dta13("data/dta_119.dta", select.rows = c(5, 10)) +dd118 <- read.dta13("data/dta_118.dta", select.rows = c(5, 10)) +dd117 <- read.dta13("data/dta_117.dta", select.rows = c(5, 10)) +dd115 <- read.dta13("data/dta_115.dta", select.rows = c(5, 10)) +dd114 <- read.dta13("data/dta_114.dta", select.rows = c(5, 10)) +dd113 <- read.dta13("data/dta_113.dta", select.rows = c(5, 10)) +dd112 <- read.dta13("data/dta_112.dta", select.rows = c(5, 10)) +dd111 <- read.dta13("data/dta_111.dta", select.rows = c(5, 10)) +dd110 <- read.dta13("data/dta_110.dta", select.rows = c(5, 10)) +dd108 <- read.dta13("data/dta_108.dta", select.rows = c(5, 10)) +dd107 <- read.dta13("data/dta_107.dta", select.rows = c(5, 10)) +dd106 <- read.dta13("data/dta_106.dta", select.rows = c(5, 10)) +dd105 <- read.dta13("data/dta_105.dta", select.rows = c(5, 10)) +dd104 <- read.dta13("data/dta_104.dta", select.rows = c(5, 10)) +dd103 <- read.dta13("data/dta_103.dta", select.rows = c(5, 10)) +dd102 <- read.dta13("data/dta_102.dta", select.rows = c(5, 10)) unlink("data", recursive = TRUE) -dd <- dd[5:10,] +dd <- dd[5:10, ] test_that("select.rows = c(5,10)", { # check numerics @@ -956,7 +956,7 @@ dd102 <- read.dta13("data/dta_102.dta", select.cols = c("disp", "drat")) unlink("data", recursive = TRUE) -dd <- dd[,c("disp", "drat")] +dd <- dd[, c("disp", "drat")] test_that("select.cols = c('disp', 'drat')", { # check numerics @@ -1026,7 +1026,7 @@ dd102 <- read.dta13("data/dta_102.dta", select.cols = c(3, 5)) unlink("data", recursive = TRUE) -dd <- dd[,c("disp", "drat")] +dd <- dd[, c("disp", "drat")] test_that("select.cols = c('disp', 'drat')", { # check numerics @@ -1159,11 +1159,11 @@ dd <- mtcars varlabeldd <- LETTERS[seq_len(ncol(dd))] varlabel(dd) <- varlabeldd -version_list <- c(102,103,104,105,106,107,108,110,111, - 112,113,114,115,117,118,119,120,121) +version_list <- c(102, 103, 104, 105, 106, 107, 108, 110, 111, + 112, 113, 114, 115, 117, 118, 119, 120, 121) # write variable label attribute -for(v in version_list) { +for (v in version_list) { save.dta13(dd, paste0("data/dta_", v, ".dta"), version = v) } @@ -1179,7 +1179,7 @@ unlink("data", recursive = TRUE) test_that("save and read varlabels", { - for(v in as.character(version_list)) { + for (v in as.character(version_list)) { expect_equal(varlabeldd, varlabeldd_read[[v]]) } @@ -1261,10 +1261,10 @@ dir.create("data") # strLs can be of length any length up to 2 billion characters. Starting with # 2046 a string is handled as a strL -dd <- data.frame( dat = c(paste(replicate(2046, "a"), collapse = ""), - paste(replicate(2046, "b"), collapse = ""), - "NA", NA_character_), - stringsAsFactors = FALSE) +dd <- data.frame(dat = c(paste(replicate(2046, "a"), collapse = ""), + paste(replicate(2046, "b"), collapse = ""), + "NA", NA_character_), + stringsAsFactors = FALSE) save.dta13(dd, "data/dta_121.dta", version = 121) save.dta13(dd, "data/dta_120.dta", version = 120)