# R/clean_dataset.R In azizka/CoordinateCleaner: Automated Cleaning of Occurrence Records from Biological Collections

#### Documented in clean_dataset

#' Coordinate Cleaning using Dataset Properties
#'
#' Tests for problems associated with coordinate conversions and rounding,
#' based on dataset properties. Includes test to identify contributing datasets with
#' potential errors with converting ddmm to dd.dd, and
#' periodicity in the data decimals indicating rounding or a raster basis
#' linked to low coordinate precision. Specifically:
#' * ddmm  tests for erroneous conversion from a degree
#' minute format (ddmm) to a decimal degree (dd.dd) format
#' * periodicity test for periodicity in the data,
#' which can indicate imprecise coordinates, due to rounding or rasterization.
#'
#' These tests are based on the statistical distribution of coordinates and
#'  their decimals within
#' datasets of geographic distribution records to identify datasets with
#' potential errors/biases. Three potential error sources can be identified.
#' The ddmm flag tests for the particular pattern that emerges if geographical
#' coordinates in a degree minute annotation are transferred into decimal
#' degrees, simply replacing the degree symbol with the decimal point. This
#' kind of problem has been observed by in older datasets first recorded on
#' paper using typewriters, where e.g. a floating point was used as symbol for
#' degrees. The function uses a binomial test to check if more records than
#' expected have decimals below 0.6 (which is the maximum that can be obtained
#' in minutes, as one degree has 60 minutes) and if the number of these records
#' is higher than those above 0.59 by a certain proportion. The periodicity
#' test uses rate estimation in a Poisson process to estimate if there is
#' periodicity in the decimals of a dataset (as would be expected by for
#' example rounding or data that was collected in a raster format) and if there
#' is an over proportional number of records with the decimal 0 (full degrees)
#' which indicates rounding and thus low precision. The default values are
#' empirically optimized by with GBIF data, but should probably be adapted.
#'
#' @aliases CleanCoordinatesDS
#'
#' @param ds a character string. The column with the dataset of each record. In
#' case \code{x} should be treated as a single dataset, identical for all
#' records. Default = \dQuote{dataset}.
#' @param tests a vector of character strings, indicating which tests to run.
#' See details for all tests available. Default = c("ddmm", "periodicity")
#' \code{\link{cd_round}} to customize test sensitivity.
#' @param value a character string.  Defining the output value. See value.
#' Default = \dQuote{dataset}.
#' @inheritParams cc_cap
#'
#' @return Depending on the \sQuote{value} argument:
#' \describe{
#'   \item{\dQuote{dataset}}{a \code{data.frame} with the
#'   the test summary statistics for each dataset in \code{x}}
#'   \item{\dQuote{clean}}{a \code{data.frame} containing only
#'   records from datasets in \code{x} that passed the tests}
#'   \item{\dQuote{flagged}}{a logical vector of the same length as
#'   rows in \code{x}, with TRUE = test passed and
#'   FALSE = test failed/potentially problematic.}
#' }
#'
#' @note See \url{https://ropensci.github.io/CoordinateCleaner/} for more details
#' and tutorials.
#'
#' @keywords Coordinate cleaning wrapper
#' @family Wrapper functions
#'
#' @examples
#' #Create test dataset
#' clean <- data.frame(dataset = rep("clean", 1000),
#'                     decimallongitude = runif(min = -43, max = -40, n = 1000),
#'                     decimallatitude = runif(min = -13, max = -10, n = 1000))
#'
#' bias.long <- c(round(runif(min = -42, max = -40, n = 500), 1),
#'                round(runif(min = -42, max = -40, n = 300), 0),
#'                runif(min = -42, max = -40, n = 200))
#' bias.lat <- c(round(runif(min = -12, max = -10, n = 500), 1),
#'               round(runif(min = -12, max = -10, n = 300), 0),
#'               runif(min = -12, max = -10, n = 200))
#' bias <- data.frame(dataset = rep("biased", 1000),
#'                    decimallongitude = bias.long,
#'                    decimallatitude = bias.lat)
#' test <- rbind(clean, bias)
#'
#' \dontrun{
#' #run clean_dataset
#' flags <- clean_dataset(test)
#'
#' #check problems
#' #clean
#' hist(test[test$dataset == rownames(flags[flags$summary,]), "decimallongitude"])
#' #biased
#' hist(test[test$dataset == rownames(flags[!flags$summary,]), "decimallongitude"])
#'
#' }
#' @export
#' @importFrom stats complete.cases
#' @md
clean_dataset <- function(x,
lon = "decimallongitude",
lat = "decimallatitude",
ds = "dataset",
tests = c("ddmm", "periodicity"),
value = "dataset",
verbose = TRUE,
...) {

# check input arguments
match.arg(value, choices = c("dataset", "flagged", "clean"))

# check column names
nams <- c(lon, lat, ds)
if (!all(nams %in% names(x))) {
}

# prepare input data
dat <- x[, c(lon, lat, ds)]
dat[[ds]] <- as.character(dat[[ds]])

## kick out NAs
if (sum(!complete.cases(dat)) > 0) {
warning(sprintf(
"Incomplete cases found. value set to 'dataset',
ignoring %s cases with incomplete data",
sum(!complete.cases(dat))
))
dat <- dat[complete.cases(dat), ]
value <- "dataset"
}

# perpare dummy value in case value == 'clean'
if (value == "clean") {
value2 <- "flagged"
} else {
value2 <- value
}

if (nrow(dat) == 0) {
stop("no complete cases found")
}

## create test columns: decimal degrees long and lat
dat$lon.test <- abs(dat[[lon]]) - floor(abs(dat[[lon]])) dat$lat.test <- abs(dat[[lat]]) - floor(abs(dat[[lat]]))

## split into seperate datasets
test <- split(dat, f = dat[[ds]])

# run ddmm to dd.dd conversion error at 0.6 test
if ("ddmm" %in% tests) {
out_t1 <- cd_ddmm(
x = dat, lon = lon, lat = lat, ds = ds, value = value2,
verbose = verbose, ...)
if (value == "dataset") {
names(out_t1) <- c("binomial.pvalue", "perc.difference", "pass.ddmm")
}
} else {
if (value == "dataset") {
out_t1 <- data.frame(pass.ddmm = rep(NA, length(test)))
} else {
out_t1 <- rep(NA, nrow(dat))
}
}

# Run periodicity test
if ("periodicity" %in% tests) {
out_t2 <- cd_round(x,
lon = lon,
lat = lat,
ds = ds,
value = value2,
...
)
} else {
if (value == "dataset") {
out_t2 <- data.frame(
pass.periodicity.com = rep(NA, length(test)),
pass.zero.com = rep(NA, length(test)),
summary = NA
)
} else {
out_t2 <- rep(NA, nrow(dat))
}
}

# prepare output
if (value == "dataset") {
out <- data.frame(out_t1, out_t2)
out <- Filter(function(x) !all(is.na(x)), out)
if("periodicity" %in% tests & "ddmm" %in% tests ){
out$summary <- as.logical(out_t1$pass.ddmm) & as.logical(out_t2$summary) }else if("periodicity" %in% tests & !("ddmm" %in% tests)){ out$summary <- out_t2$summary }else if(!("periodicity" %in% tests) & "ddmm" %in% tests ){ out$summary <- as.logical(out_t1$pass.ddmm) } if (verbose) { message(sprintf("Flagged %s datasets.", sum(!out$summary)))
}
}
if (value == "flagged") {
out <- data.frame(ddmm = out_t1, periodicity = out_t2)
out <- Filter(function(x) !all(is.na(x)), out)
out$summary <- Reduce("&", out) if (verbose) { message(sprintf("Flagged %s records.", sum(!out$summary)))
}
}
if (value == "clean") {
out <- data.frame(ddmm = out_t1, periodicity = out_t2)
out <- Filter(function(x) !all(is.na(x)), out)
out$summary <- Reduce("&", out) if (verbose) { message(sprintf("Flagged %s records.", sum(!out$summary)))
}
out <- dat[out\$summary, ]
}
# return output
return(out)
}

azizka/CoordinateCleaner documentation built on Dec. 7, 2019, 10:23 p.m.
{"ft_lang_label":"__label__en","ft_lang_prob":0.50148875,"math_prob":0.9841496,"size":7469,"snap":"2020-10-2020-16","text_gpt3_token_len":2077,"char_repetition_ratio":0.116142,"word_repetition_ratio":0.10837004,"special_character_ratio":0.32735306,"punctuation_ratio":0.15036497,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.99496114,"pos_list":[0],"im_url_duplicate_count":[null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2020-04-06T14:07:10Z\",\"WARC-Record-ID\":\"<urn:uuid:0e75dda1-d4b8-47c8-a473-26f603399a5d>\",\"Content-Length\":\"89605\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:c3d17455-ae4f-4b39-a4d0-7e3489e3b866>\",\"WARC-Concurrent-To\":\"<urn:uuid:da67d8a6-f482-417a-8546-df33df919c90>\",\"WARC-IP-Address\":\"104.28.6.171\",\"WARC-Target-URI\":\"https://rdrr.io/github/azizka/CoordinateCleaner/src/R/clean_dataset.R\",\"WARC-Payload-Digest\":\"sha1:AOOCIPEIN6CCOVE67TKPWHK53BSRPJBB\",\"WARC-Block-Digest\":\"sha1:QTCLVQJCJLDM2QMTOFCVZ2A2Y7FCVTJU\",\"WARC-Identified-Payload-Type\":\"text/html\",\"warc_filename\":\"/cc_download/warc_2020/CC-MAIN-2020-16/CC-MAIN-2020-16_segments_1585371637684.76_warc_CC-MAIN-20200406133533-20200406164033-00045.warc.gz\"}"}