Nothing
#'
#' RvegToJuice
#'
#' Export Rveg database to Juice software compatible format
#'
#' @param Data name of your Rveg database
#' @param checklist path to your custom species checklist
#' @param export name of your exported csv file
#'
#' @returns csv file which is readible by Juice
#'
#' @examples
#' ## NOT RUN
#' if (interactive()) {
#' RvegToJuice(Data = paste0(
#' path.package("Rveg"),
#' "/extdata/example_db"
#' ))
#' read.csv("export.csv", header = FALSE)
#' }
#'
#' @export
#'
RvegToJuice <- function(Data, checklist = "default", export = "export") {
if (export == "export") {
export <- file.path(tempdir(), "export")
}
Data_rel <- read.csv(paste0(Data, "REL.csv"), row.names = 1)
Data_head <- read.csv(paste0(Data, "HEAD.csv"), row.names = 1)
if (checklist == "default") {
checklist <- paste0(path.package("Rveg"), "/extdata/DANIHELKA2012rko.txt")
}
Splist <- read.delim(checklist, sep = "\t")
x <- NULL
y <- NULL
z <- NULL
for (i in 1:nrow(Data_rel)) {
n <- substr(Data_rel[i, 1], 9, 9)
if (n == 3) {
n <- 2
} else if (n == 2) {
n <- 4
} else if (n == 1) {
n <- 6
} else if (n == 0) {
n <- 9
} else if (n == "J") {
n <- 7
} # Juice codes for layers
y <- c(y, n) # layer column
x <- c(x, Splist[Splist[, 2] == substr(Data_rel[i, 1], 1, 7), 3]) # species names
z[[i]] <- as.vector(Data_rel[i, 2:ncol(Data_rel)]) # cover
}
tt <- data.frame(matrix(unlist(z), nrow = length(z), byrow = TRUE))
ttt <- data.frame(x, y)
tt[tt == 0] <- "."
tzt <- c(NA, NA, 1:ncol(tt))
tttt <- cbind(ttt, tt)
tttt <- rbind(tzt, tttt)
tty <- paste0("Export from ", Data)
ttz <- paste0("Number of relev\u00e9s:", ncol(tt)) # way to export Juice format
write(x = paste0(tty, "\n", ttz, "\n"), file = paste0(export, ".csv")) # possible encoding problem?
write.table(tttt, file = paste0(export, ".csv"), row.names = FALSE, col.names = FALSE, na = "", sep = ",", quote = FALSE, append = TRUE) # fileEncoding = "Windows-1252"?
}
#'
#' TvToRveg
#'
#' Export Turboveg csv file to Rveg database compatible format
#'
#' @param tv path to Turboveg csv export
#' @param export name of your exported database
#' @param checklist checklist used to match shortnames with species name
#'
#' @returns csv file
#'
#' @examples
#' ## NOT RUN
#' if (interactive()) {
#' tvToRveg(tv = paste0(
#' path.package("Rveg"),
#' "/extdata/tvexport.csv"
#' ))
#' read.csv("exportREL.csv", row.names = 1)
#' }
#'
#' @export
#'
#'
tvToRveg <- function(tv, export = "export", checklist = "default") {
if (export == "export") {
export <- file.path(tempdir(), "export")
}
data <- read.csv(tv)
lim <- as.numeric(rownames(data[data[, 1] == "", ])) # blank separator of header and relevés
tvhead <- data[1:(lim - 1), ]
tvrel <- data[(lim + 1):nrow(data), ]
rvrel <- data.frame(ShortName = character(), stringsAsFactors = FALSE)
rvhead <- data.frame(
ShortName = c(
"ID", "DATE", "SpringDATE", "LOCALITY", "FieldCODE", "Authors",
"PlotSize", "Latitude", "Longitude", "Accuracy",
"E3", "E2", "E1", "Ejuv", "E0", "Note", data[22:lim - 1, 1]
),
stringsAsFactors = FALSE
)
# header
for (i in 3:ncol(data)) {
rvhead[rvhead$ShortName == "ID", i - 1] <- tvhead[tvhead[, 1] == "Releve number", i]
rvhead[rvhead$ShortName == "DATE", i - 1] <- tvhead[tvhead[, 1] == "Date (year/month/day)", i]
rvhead[rvhead$ShortName == "LOCALITY", i - 1] <- tvhead[tvhead[, 1] == "Releve number", i]
rvhead[rvhead$ShortName == "FieldCODE", i - 1] <- tvhead[tvhead[, 1] == "Releve number", i]
rvhead[rvhead$ShortName == "Authors", i - 1] <- "unknown"
rvhead[rvhead$ShortName == "PlotSize", i - 1] <- tvhead[tvhead[, 1] == "Releve area (m2)", i]
rvhead[rvhead$ShortName == "Latitude", i - 1] <- "unknown"
rvhead[rvhead$ShortName == "Longitude", i - 1] <- "unknown"
rvhead[rvhead$ShortName == "E3", i - 1] <- tvhead[tvhead[, 1] == "Cover tree layer (%)", i]
rvhead[rvhead$ShortName == "E2", i - 1] <- tvhead[tvhead[, 1] == "Cover shrub layer (%)", i]
rvhead[rvhead$ShortName == "E1", i - 1] <- tvhead[tvhead[, 1] == "Cover herb layer (%)", i]
rvhead[rvhead$ShortName == "Note", i - 1] <- tvhead[tvhead[, 1] == "Remarks", i]
rvhead[17:(17 + lim - 22), i - 1] <- tvhead[22:lim - 1, i] # matching consistent header characteristics
}
colnames(rvhead) <- c("","ShortName", paste0("X", c(1:(ncol(rvhead) - 2))))
# header end
if (checklist == "default") {
checklist <- paste0(path.package("Rveg"), "/extdata/DANIHELKA2012rko.txt")
}
SpLIST1 <- read.delim(checklist, sep = "\t")
SpLIST <- makeSpLIST(checklist)
for (i in 1:nrow(tvrel)) {
if (substr(tvrel[i, 2], 1, 1) == "h") {
abc <- 1
} else if (substr(tvrel[i, 2], 1, 1) == "s") {
abc <- 2
} else if (substr(tvrel[i, 2], 1, 1) == "t") {
abc <- 3
} else if (substr(tvrel[i, 2], 1, 1) == "m") {
abc <- 0
}
tvrel[i, 2] <- abc
} # converting TV layer codes
tvrel[tvrel == ""] <- 0
while (TRUE) {
cla <- readline("Data in Bran blanquet or percentage? (B/%)") # converting to percentage
if (cla == "B") {
for (i in 1:ncol(tvrel[, c(-1, -2)])) {
for (l in 1:nrow(tvrel[, c(-1, -2)])) {
if (tvrel[, c(-1, -2)][l, i] == 1) {
tvrel[, c(-1, -2)][l, i] <- 3
} else if (tvrel[, c(-1, -2)][l, i] == 2) {
tvrel[, c(-1, -2)][l, i] <- 15
} else if (tvrel[, c(-1, -2)][l, i] == 3) {
tvrel[, c(-1, -2)][l, i] <- 38
} else if (tvrel[, c(-1, -2)][l, i] == 4) {
tvrel[, c(-1, -2)][l, i] <- 63
} else if (tvrel[, c(-1, -2)][l, i] == 5) {
tvrel[, c(-1, -2)][l, i] <- 88
} else if (tvrel[, c(-1, -2)][l, i] == "+") {
tvrel[, c(-1, -2)][l, i] <- 2
} else if (tvrel[, c(-1, -2)][l, i] == "r") {
tvrel[, c(-1, -2)][l, i] <- 1
} else if (tvrel[, c(-1, -2)][l, i] == "2a") {
tvrel[, c(-1, -2)][l, i] <- 8
} else if (tvrel[, c(-1, -2)][l, i] == "2b") {
tvrel[, c(-1, -2)][l, i] <- 18
} else if (tvrel[, c(-1, -2)][l, i] == "2m") {
tvrel[, c(-1, -2)][l, i] <- 4
}
}
}
break
} else if (cla == "%") {
break
}
}
for (s in tvrel[, 1]) {
if (length((s == tvrel[, 1])[(s == tvrel[, 1]) == TRUE]) > 1) {
l1 <- as.numeric(tvrel[s == tvrel[, 1], ][1, c(-1, -2)])
l1[is.na(l1)] <- 0
l2 <- as.numeric(tvrel[s == tvrel[, 1], ][2, c(-1, -2)])
l2[is.na(l2)] <- 0
r1 <- rownames(tvrel[s == tvrel[, 1], ][2, c(-1, -2)])
l3 <- round(l1 + (l2 * (1 - (l1 / 100))))
tvrel[tvrel[, 1] == s, ][1, c(-1, -2)] <- l3
tvrel <- tvrel[!(rownames(tvrel) %in% r1), ] # merginng more detailed TV layers (eg t1 with t2 etc.)
}
}
for (i in 1:nrow(tvrel)) {
sp <- SpLIST[SpLIST$FullName == tvrel[i, 1], 2][substr(SpLIST[SpLIST$FullName == tvrel[i, 1], 2], 9, 9) == tvrel[i, 2]][1]
rvrel[i, 1] <- sp
rrn <- rownames(SpLIST[SpLIST$ShortName == sp, ])
if (!is.na(sp)) {
rownames(rvrel)[i] <- rownames(SpLIST[SpLIST$ShortName == sp, ])
} # writing fullnames
print(tvrel[i, 1])
print(rvrel[i, 1])
while (TRUE) {
check <- toupper(readline("correct name?(blank/N) ")) # doublecheck for correct code
if (check == "" & !is.na(rvrel[i, 1])) {
break
}
if (check == "N") {
while (TRUE) {
k <- readline("AddSpeciesFirst3letters(eg.Che)? ")
tt <- toupper(readline("Correct 3 letters? Y/N "))
if (tt == "Y") {
break
}
}
k <- paste0(toupper(substr(k, 1, 1)), tolower(substr(k, 2, 3)))
print(SpLIST1[grep(paste0("^", k), SpLIST1[, 3]), ])
while (TRUE) {
while (TRUE) {
s <- toupper(readline("SpeciesName?(7lettersGenuSpe) "))
if (nchar(s) == 7) {
nana <- paste(s, abc, sep = "_")
specie_check <- SpLIST[SpLIST[, 2] == substr(nana, 1, 9), ]
print(specie_check[3])
break
}
}
tt <- toupper(readline("Correct 7lettersGenuSpe Y/N "))
if ((tt == "Y") & !is.na(specie_check[1, 3])) {
rvrel[i, 1] <- nana
rownames(rvrel)[i] <- rownames(specie_check)
break
}
break
}
break
}
}
}
DATA <- cbind(rvrel, tvrel[, c(-1, -2)])
colnames(DATA) <- c("ShortName", paste0("X", c(1:(ncol(DATA) - 1))))
write.csv(DATA, paste0(export, "REL.csv"))
write.csv(rvhead, paste0(export, "HEAD.csv"))
}
#'
#' RvegToTv
#'
#' Export Turboveg csv compatible file
#'
#' @param database path to Rveg database
#' @param export name of your exported Tv file
#' @param ver version of TURBOVEG
#' @param checklist checklist to match Fullnames
#'
#' @returns csv file
#'
#' @examples
#' ## NOT RUN
#' if (interactive()) {
#' RvegToTv(database = paste0(
#' path.package("Rveg"),
#' "/extdata/example_db"
#' ))
#' }
#'
#' @export
#'
#'
#'
RvegToTv <- function(database, export = "export", ver = 3, checklist = "default") {
if (export == "export") {
export <- file.path(tempdir(), "export")
}
if (checklist == "default") {
checklist <- paste0(path.package("Rveg"), "/extdata/DANIHELKA2012rko.txt")
}
# splist
SpLIST1 <- read.delim(checklist, sep = "\t")
SpLIST <- makeSpLIST(checklist)
### Header
header <- read.csv(paste0(database, "HEAD.csv"))
header[, 1] <- header[, 2]
header[, 2] <- ""
### Rel
rel <- read.csv(paste0(database, "REL.csv"))
## fullnames
rel$Fullname <- substr(rel$ShortName, 1, 7)
for (i in 1:nrow(rel)) {
rel$Fullname[i] <- SpLIST1[SpLIST1[, 2] == rel$Fullname[i], 3]
}
## layers
rel$Layer <- substr(rel$ShortName, 9, 9)
for (i in 1:nrow(rel)) {
if (rel$Layer[i] == 1) {
rel$Layer[i] <- "hl"
} else if (rel$Layer[i] == 2) {
rel$Layer[i] <- "s1"
} else if (rel$Layer[i] == 3) {
rel$Layer[i] <- "t1"
} else if (rel$Layer[i] == 0) {
rel$Layer[i] <- "ml"
} else if (rel$Layer[i] == "J") {
rel$Layer[i] <- "jl"
}
}
if (ver == 3) {
rel <- cbind(rel$Fullname, rel$Layer, rel[, -c(1, 2, ncol(rel), ncol(rel) - 1)])
names(rel) <- 1:ncol(rel)
names(header) <- 1:ncol(header)
out <- rbind(header, c(rep("", ncol(header))), rel)
colnames(out)<-out[1,]
write.csv(out[-1,], paste0(export,".csv"), row.names = F)
} else if (ver == 2) {
# rel
rel <- cbind(rel$Fullname, rel$Layer, rel[, -c(1, 2, ncol(rel), ncol(rel) - 1)])
names(rel) <- rel[1,]
write.csv(rel[-1,], paste0(export,"R.csv"), row.names = F)
# head
header<-as.data.frame(t(header))
colnames(header) <- header[1,]
write.csv(header[-1,],paste0(export,"H.csv"), row.names = F)
}
}
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.