Nothing
#'
#' RvegCheck
#'
#' Checking your DATABASE for duplicity and allowing to export table with full species name (not editable anymore).
#'
#' @param DATABASE name of csv files for releve table and header - database
#' @param fullnames logical value if you want to add fullnames to the database
#' @param export name of exporting database
#' @param checklist checklist used to match shortnames with species name
#'
#' @returns Export csv file releve table
#'
#' @examples
#' ## NOT RUN
#' if (interactive()) {
#' RvegCheck(DATABASE = paste0(
#' path.package("Rveg"),
#' "/extdata/example_db"
#' ))
#' read.csv("exportREL.csv", row.names = 1)
#' }
#'
#' @export
#'
RvegCheck <- function(DATABASE, fullnames = FALSE, export = "export", checklist = "default") {
if (export == "export") {
export <- file.path(tempdir(), "export")
}
DATA <- read.csv(paste0(DATABASE, "REL.csv"), row.names = 1)
if (checklist == "default") {
checklist <- paste0(path.package("Rveg"), "/extdata/DANIHELKA2012rko.txt")
}
SpLIST <- read.delim(checklist, sep = "\t")
fullName <- c(rep("", nrow(DATA)))
DATA <- cbind(fullName, DATA)
for (i in 1:length(DATA$ShortName)) {
DATA$fullName[i] <- SpLIST$FullName[SpLIST$ShortName == substr(DATA$ShortName[i], 1, 7)]
}
for (i in 1:length(DATA$fullName)) {
if (length(unique(substr(DATA$ShortName[DATA$fullName == DATA$fullName[i]], 1, 7))) > 1) {
message(paste0("found duplicate codes for ", DATA$fullName[i], "\n"))
message(unique(substr(DATA$ShortName[DATA$fullName == DATA$fullName[i]], 1, 7)))
message("\n")
print(DATA[DATA$fullName == DATA$fullName[i], ])
while (TRUE) {
met <- toupper(readline("select merging method?(M - merge, N - none) "))
if (met == "M") {
message("This merging method will keep the higher value")
while (TRUE) {
l1 <- as.numeric(readline("select first row (with correct code) "))
l2 <- as.numeric(readline("select second row "))
if (is.na(l1) != TRUE & is.na(l2) != TRUE & isTRUE(l1 %in% as.numeric(row.names(DATA))) & isTRUE(l2 %in% as.numeric(row.names(DATA)))) {
break
}
}
for (i in 1:length(DATA[row.names(DATA) == l1, ])) {
if (is.numeric(DATA[l1, i])) {
DATA[row.names(DATA) == l1, i] <- max(c(DATA[row.names(DATA) == l1, i], DATA[row.names(DATA) == l2, i]))
}
}
DATA <- DATA[!(row.names(DATA) == l2), ]
break
}
if (met == "N") {
break
}
}
}
}
if (fullnames) {
write.csv(DATA, paste0(export, "REL.csv"))
} else {
write.csv(DATA[-1, ], paste0(export, "REL.csv"))
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.