数据集数值调整：将分位数与均值映射至指定区间并拉伸

更新说明 #

Zephryl已给出出色解答，以下补充初始问题的细节。

数据集 #

data <- structure(list(country = c("Italy", "Italy", "Italy", "Italy", 
                       "Italy", "Italy", "Italy", "Italy", "Italy", "Austria", "Austria", 
                       "Austria", "Austria", "Austria", "Austria", "Austria", "Austria", 
                       "Austria", "Spain", "Spain", "Spain", "Spain", "Spain", "Spain", 
                       "Spain", "Spain", "Spain", "Portugal", "Portugal", "Portugal", 
                       "Portugal", "Portugal", "Portugal", "Portugal", "Portugal", "Portugal"), date = structure(c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 1L, 
                  2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 
                  9L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L), levels = c("1000", "1200", 
                                                                      "1300", "1400", "1500", "1600", "1700", "1750", "1800"), class = "factor"), fit.0.025quant = c(0.828858435568409, 2.49016922773755, 2.65828836880409, 
               2.66581093505707, 2.57548603944065, 1.67885386266028, 0.767937801519583, 
               0.689014091834041, 0.66513695912892, 0.663699022639656, 0.678689217926065, 
               0.67888578207667, 0.678889008309296, 0.678889067277956, 0.678889008315121, 
               0.678885782094281, 0.67868921794039, 0.663699022695475, 0.753024027011781, 
               1.56176460225556, 1.66925563033888, 1.56663639224176, 0.757961319722877, 
               0.690760522079772, 0.688181548019768, 0.760878851337501, 
               1.5613478080279, 0.664563945566996, 0.68508607246818, 0.737286017774939, 
               1.5119543712026, 0.819687233979314, 1.60507738574301, 1.66679441254118, 
               1.68306812289583, 1.66919593888341), fit.mean = c(1.13400448293661, 
                                                                 2.87830024613312, 2.98840123437886, 2.99270845416986, 2.93292120022681, 
                                                                 2.00001375693309, 1.06700462995692, 1.00618961591289, 1.0007893132799, 
                                                                 1.00004363941275, 1.00003146052876, 1.00003107297182, 1.00003106386579, 
                                                                 1.00003106366991, 1.00003106386888, 1.00003107297307, 1.00003146052807, 
                                                                 1.00004363941059, 1.06578800415204, 1.92791273808794, 2.00911809484502, 
                                                                 1.92938242492218, 1.05953000948759, 1.00731995863015, 1.00551539597356, 
                                                                 1.0617929411748, 1.93397100841674, 1.00049922917461, 1.00391214501682, 
                                                                 1.04414180746079, 1.89014845620677, 1.1133844912819, 1.94890869596221, 
                                                                 1.99253538304467, 2.00313100995317, 2.00364556256633), fit.0.975quant = c(1.5548453965449, 
                                                                                                                                           3.17193689185671, 3.30217150519806, 3.30887034452248, 3.23188378430461, 
                                                                                                                                           2.32122877803568, 1.42445510409649, 1.33229333739629, 1.33797676580827, 
                                                                                                                                           1.33651739528035, 1.32146593655336, 1.32126741860939, 1.32126414685111, 
                                                                                                                                           1.32126408690283, 1.32126414685902, 1.32126741859377, 1.32146593653428, 
                                                                                                                                           1.33651739521255, 1.43806634680653, 2.23154393918938, 2.35542858727393, 
                                                                                                                                           2.23131692404623, 1.40982833868788, 1.33388203589275, 1.33103300867831, 
                                                                                                                                           1.41382643372889, 2.24644777498799, 1.33739126255841, 1.32804123237336, 
                                                                                                                                           1.38436190848754, 2.18404788457664, 1.4941065137638, 2.25306205937895, 
                                                                                                                                           2.30955823803133, 2.32596318832388, 2.34217586698821)), row.names = c(1L, 
                                                                                                                                                                                                                 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 
                                                                                                                                                                                                                 16L, 17L, 18L, 91L, 92L, 93L, 94L, 95L, 96L, 97L, 98L, 99L, 100L, 
                                                                                                                                                                                                                 101L, 102L, 103L, 104L, 105L, 106L, 107L, 108L), class = "data.frame")

需求说明 #

• 对数据集中每一行的fit.0.025quant、fit.mean、fit.0.975quant三个值执行以下操作：
  1. 确定当前三个值所在区间的最大整数n（例如意大利1000年数据的最大整数是1，意大利1200年数据的最大整数是3）
  2. 将这三个值映射到区间n.01至(n+1).99
  3. 拉伸数据，使其尽可能覆盖n.01-(n+1).99的连续区间；若原值已处于该区间，直接拉伸至覆盖整个区间

解决方案代码 #

以下是自动处理整个数据集的R代码，通过自定义函数实现映射与拉伸逻辑：

# 定义映射拉伸函数
map_stretch <- function(row) {
  # 提取当前行的三个分位数数值
  vals <- c(row[["fit.0.025quant"]], row[["fit.mean"]], row[["fit.0.975quant"]])
  # 确定最大整数n
  n <- floor(max(vals))
  # 目标区间的上下限
  target_min <- n + 0.01
  target_max <- (n + 1) - 0.01
  # 原区间的上下限
  orig_min <- min(vals)
  orig_max <- max(vals)
  
  # 执行线性拉伸映射
  stretched_vals <- target_min + (vals - orig_min) * (target_max - target_min) / (orig_max - orig_min)
  
  # 返回处理后的值，保留原行列信息
  row[["fit.0.025quant"]] <- stretched_vals[1]
  row[["fit.mean"]] <- stretched_vals[2]
  row[["fit.0.975quant"]] <- stretched_vals[3]
  return(row)
}

# 应用函数到整个数据集
processed_data <- do.call(rbind, lapply(1:nrow(data), function(i) map_stretch(data[i,])))

# 查看处理后的结果示例
head(processed_data)

代码解释 #

1. map_stretch函数：
   • 提取每行的三个分位数数值，计算它们的最大整数n
   • 定义目标区间n.01到(n+1).99
   • 使用线性插值公式将原区间的数值映射到目标区间，确保最小值对应n.01，最大值对应(n+1).99，中间值按比例缩放
2. 批量处理：通过lapply遍历数据集的每一行，应用函数后用do.call(rbind, ...)重新组合成数据框

内容的提问来源于stack exchange，提问作者Rustam