如何使用小數轉換年，月，日的年齡

Question

假設我有一個字符串

   age<-c("7y2m4d","5m4d","7y5m6d")

我想將它轉換為數字向量

  c(7.34, 0.43, 7.43)

我怎樣才能制作R代碼？

我們可以假設一年365天，一個月365/12天。

Answer 1

lubridate::duration會將你的字符串轉換為（近似）秒。

library(lubridate)
library(magrittr)
age <- c("7y2m4d", "5m4d", "7y5m6d")

age_sec <- age %>%
  duration() %>%
  as.numeric()

age_sec
[1] 226508400  13494600 234570600

然后您可以將年份近似為365 * 24 * 60 * 60秒：

age_sec / (365 * 24 * 60 * 60)
[1] 7.182534 0.427911 7.438185

Answer 2

基礎R的另一個解決方案：

age<-c("7y2m4d","5m4d","7y5m6d")


age <- gsub('y', ' + ', age)
age <- gsub('m', ' / 12 + ', age)
age <- gsub('d', ' / 365', age)

sapply(age, function(x) eval(parse(text = x)))
#7 + 2 / 12 + 4 / 365     5 / 12 + 4 / 365 7 + 5 / 12 + 6 / 365 
#           7.1776256            0.4276256            7.4331050 

我們的想法是創建公式，然后為矢量的每個元素評估它。

Answer 3

這些解決方案

• 處理缺少y，m和/或d和
• 給出與問題中相同的答案（問題似乎沒有錯誤地計算答案的第一個age元素除外）
• 避免使用eval
• 僅使用基地（替代1a除外）

在簡單（1a）的基礎上比較下面的解決方案是最簡單的，並且自動處理所有邊緣情況，沒有特定的代碼，表明它是最自然的; 但是，它確實使用了一個包。 （1）僅稍微復雜並且不使用包裝和（2）非常短並且也不使用任何包裝但是它不像（1）或（1a）那么簡單。

1）這里getNum提取並返回與代碼關聯的x中的數字（代碼為“y”，“m”或“d”）或者如果代碼不存在於x返回0.然后我們將年份相加，月/ 12和日/ 365。

getNum <- function(code, x) {
  pat <- sprintf(".*?(\\d+)%s.*", code)
  as.numeric(ifelse(grepl(code, x), sub(pat, "\\1", x), 0))
}
getNum("y", age) + getNum("m", age) / 12 + getNum("d", age) / 365
## [1] 7.1776256 0.4276256 7.4331050

1a）這類似於（1），除了我們在gsubfn中使用strapply來簡化getNum 。 事實上， getNum為單個strapply調用，它使用的正則表達式也更簡單。

library(gsubfn)

 getNum <- function(code, x) {
   strapply(x, paste0("(\\d+)", code), as.numeric, empty = 0, simplify = TRUE)
 }
getNum("y", age) + getNum("m", age) / 12 + getNum("d", age) / 365
## [1] 7.1776256 0.4276256 7.4331050

2）此替代方法將每個字符串轉換為dcf格式，並使用read.dcf創建y，m和d數字的矩陣。

詳細地說，第一行代碼是處理某些邊緣情況，這些邊緣情況實際上不存在於問題中的樣本數據中。 如果d缺失，我們首先將0d附加到age （來自問題），以便我們可以處理y，m和d都缺失的情況。 我們還預先添加一個虛擬條目，以確保y，m和d出現在至少一個條目中。 如果我們知道y，m和d存在於至少一個組件中並且沒有組件中y，m和d都同時缺失，則可以省略第一行代碼。

第二行代碼將每個輸入字符串轉換為dcf形式，並將其讀入矩陣，確保列按已知順序刪除上面添加的虛擬條目。

最后，我們將N替換為0，並使用矩陣乘法來計算年，月/ 12和日/ 365。

a0 <- c("0y0m0d", paste0(age, ifelse(grepl("d", age), "", "0d")))
m <- read.dcf(textConnection(gsub("(\\d+)(\\D)", "\\2: \\1\n", a0)))[-1, c("y", "m", "d")]
m[is.na(m)] <- 0
c(array(as.numeric(m), dim(m)) %*% c(1, 1/12, 1/365))
## [1] 7.1776256 0.4276256 7.4331050

更新：重新排列並添加（1）和（1a）。