Mik*_*kko 4 algorithm r sequence
我想为R中的数字生成连续引用数字.如果数字是连续的,则数字应用连字符分隔.否则数字用逗号分隔.例如,数字1, 2, 3, 5, 6, 8, 9, 10, 11 and 13应该是1-3,5,6,8-11,13.
这个问题之前已经回答过c#,我编写了一个适用于R的函数,但是这个函数可以改进.我发布此问题作为其他可能有类似需求的参考.如果您发现R的类似问题(我没有),请投票结束,我将删除该问题.
下面的功能不是很优雅,但似乎可以完成这项工作.如何使功能更短更优雅?
x <- c(1,2,3,5,6,8,9,10,11,13)
library(zoo) ## the function requires zoo::na.approx function
##' @title Generate hyphenated sequential citation from an integer vector
##' @param x integer vector giving citation or page numbers
##' @importFrom zoo na.approx
seq.citation <- function(x) {
## Result if lenght of the integer vector is 1.
if(length(x) == 1) return(x) else {
## Sort
x <- sort(x)
## Difference
df <- diff(x)
## Index to determine start and end points
ind <- c("start", rep("no", length(df)-1), "end")
ind[which(df > 1)] <- "end"
## Temporary start point vector
sts <- which(ind == "end") + 1
ind[sts[sts < length(ind)]] <- "start"
## Replace the first index element
ind[1] <- "start"
## Replace the last index element, if preceding one is "end"
if(ind[length(ind)-1] == "end") ind[length(ind)] <- "start"
## Groups for comma separation using "start" as the determining value.
grp <- rep(NA, length(x))
grp[which(ind == "start")] <- 1:length(grp[which(ind == "start")])
grp <- zoo::na.approx(grp, method = "constant", rule = 2)
## Split sequences by group
seqs <- split(x, grp)
seqs <- lapply(seqs, function(k) {
if(length(k) == 1) k else {
if(length(k) == 2) paste(k[1], k[2], sep = ",") else {
paste(k[1], k[length(k)], sep = "-")
}}
})
## Result
return(do.call("paste", c(seqs, sep = ",")))
}
}
seq.citation(x)
# [1] "1-3,5,6,8-11,13"
Run Code Online (Sandbox Code Playgroud)
这适用于您的示例,并且应该相当通用。
# get run lengths of differences, with max value of 2
r <- rle(c(1, pmin(diff(x), 2)))
# paste selected x values with appropriate separator
res <- paste0(x[c(1, cumsum(r$lengths))], c("-", ",")[r$values], collapse="")
# drop final character, which is a separator
res <- substr(res, 1, nchar(res)-1)
Run Code Online (Sandbox Code Playgroud)
这返回
res
[1] "1-3,5-6,8-11,13"
Run Code Online (Sandbox Code Playgroud)
您可以通过基地R使用tapply,轻松完成此操作,
paste(tapply(x, cumsum(c(1, diff(x) != 1)), function(i)
ifelse(length(i) > 2, paste0(head(i, 1), '-', tail(i, 1)),
paste(i, collapse = ','))), collapse = ',')
[1] "1-3,5,6,8-11,13"
Run Code Online (Sandbox Code Playgroud)
当然,还有seqToHumanReadable来自“R.utils”包的函数。
library(R.utils)
seqToHumanReadable(x)
# [1] "1-3, 5, 6, 8-11, 13"
seqToHumanReadable(x, tau = 1) ## If you want 5-6 and not 5, 6
# [1] "1-3, 5-6, 8-11, 13"
Run Code Online (Sandbox Code Playgroud)
结果的外观也可以控制:
seqToHumanReadable(x, delimiter = "...", collapse = " | ")
# [1] "1...3 | 5 | 6 | 8...11 | 13"
Run Code Online (Sandbox Code Playgroud)