R语言：while循环调用sRGB_to_CAM16UCS函数报错，直接调用正常

错误1：atan2(b, a) : non-numeric argument to mathematical function #

原因 #

循环调用函数时，rgb_vals[test, 1]这种索引方式返回的是一行一列的tibble（数据框对象），而非单个数值。函数内部计算基于数值类型，传入数据框后导致后续变量a、b变为数据框类型，atan2无法处理非数值输入。

解决方法 #

将索引方式改为提取单个数值的形式，用[[替代[：

# 修改循环内的函数调用
test_r <- sRGB_to_CAM16UCS(rgb_vals[[test, 1]], rgb_vals[[test, 2]], rgb_vals[[test, 3]])

错误2：列名重复错误 #

原因 #

函数返回的tibble包含原始RGB值（R255, G255, B255），而rgb_vals中已有对应的r1, g1, b1列，最终cbind时出现列名冲突。

解决方法 #

两种可行思路：

1. 修改函数返回值：仅返回转换后的结果，去掉原始RGB列：

# 修改函数的return语句
return(tibble(h_ucs, J_ucs, M_ucs, a_ucs, b_ucs))

2. 批量处理替代循环：利用purrr::pmap_dfr实现向量化操作，避免手动循环，更高效且自动合并结果：

# 替换整个while循环部分
output <- rgb_vals %>%
  mutate(pmap_dfr(., sRGB_to_CAM16UCS))

完整修正代码 #

library(purrr) 
library(tibble)
library(dplyr)
library(extraDistr) # 用于rdunif函数

sRGB_to_CAM16UCS <- function(R255, G255, B255){
  # Convert sRGB to 1931 CIE XYZ [IEC 61966-2–1:2003(E)]
  R1 <- R255 / 255
  G1 <- G255 / 255
  B1 <- B255 / 255
  
  gamma_inverse <- function(RGB1){
    if (RGB1 < -0.04045 | RGB1 > 0.04045){
      ((RGB1 + 0.055)/1.055)^2.4
    } else {
      RGB1/12.92
    }
  }
  R_li <- gamma_inverse(R1)
  G_li <- gamma_inverse(G1)
  B_li <- gamma_inverse(B1)
  
  # Convert linear RGB to CIE XYZ
  X <- 41.24 * R_li + 35.76 * G_li + 18.05 * B_li
  Y <- 21.26 * R_li + 71.52 * G_li + 7.22 * B_li
  Z <- 1.93 * R_li + 11.92 * G_li + 95.05 * B_li
  
  # Convert XYZ to CAM16
  X_w <- 96.4212
  Y_w <- 100
  Z_w <- 82.5188
  L_A <- 40
  Y_b <- 20
  surround <- 2 
  discounting <- FALSE
  
  M16 <- matrix(c(0.401288,-0.250268,-0.002079,
                  0.650173, 1.204414, 0.048952,
                  -0.051461, 0.045854, 0.953127), nrow = 3, ncol=3)
  
  lerp <- function(a,b,c){
    (1 - c) * a + c * b
  }
  
  crop <- function(a,b,c){
    pmin(pmax(c, a), b)
  }
  
  adapt <- function(component){
    con <- (F_L * abs(component) * 0.01)^0.42
    sign(component) * 400 * con / (con + 27.13)
  }  
  
  unadapt <- function(component){
    sign(component) * 100 / F_L * ((27.13* abs(component))/(400-abs(component)))^2.38095238095
  }
  
  # CAM16 Calculations
  if (surround >=1){
    c <- lerp(0.59, 0.69, surround-1)
  }else{
    c <- lerp(0.525, 0.59, surround)
  } 
  
  if (c >= 0.59){
    N_c <- lerp(0.9, 1.0, (c - 0.59)/.1)
  } else {
    N_c <- lerp(0.8, 0.9, (c - 0.525)/0.065)
  }
  
  k <- 1/(5*L_A + 1)
  F_L <- k^4 * L_A + 0.1 * (1-k^4)^2 * (5 * L_A)^(1/3)
  n <- Y_b / Y_w
  z <- 1.48 + sqrt(n)
  N_bb <- 0.725 * n^-0.2
  
  if (discounting == FALSE){
    D <- crop(0,1,N_c* (1 - 1/3.6 * exp((-L_A - 42)/92)))
  }else {
    D <- 1
  }
  
  RGB_w <- matrix(c(M16[1,1] * X_w + M16[1,2] * Y_w + M16[1,3] * Z_w,
                    M16[2,1] * X_w + M16[2,2] * Y_w + M16[2,3] * Z_w,
                    M16[3,1] * X_w + M16[3,2] * Y_w + M16[3,3] * Z_w), nrow = 3, ncol=1)
  
  D_RGB <- apply(RGB_w, c(1, 2), function(x)((1 - D) * 1 + D * Y_w/x))
  RGB_cw <- RGB_w*D_RGB
  RGB_aw <- apply(RGB_cw, c(1,2), adapt)
  A_w <- N_bb * ( 2 * RGB_aw[1,1] + RGB_aw[2,1] + 0.05 * RGB_aw[3,1])
  
  R_a <- adapt((M16[1,1] * X + M16[1,2] * Y + M16[1,3] * Z) * D_RGB[1,1])
  G_a <- adapt((M16[2,1] * X + M16[2,2] * Y + M16[2,3] * Z) * D_RGB[2,1])
  B_a <- adapt((M16[3,1] * X + M16[3,2] * Y + M16[3,3] * Z) * D_RGB[3,1])
  
  # Calculate Hue
  a_val <-  R_a + (-12 * G_a + B_a) / 11
  b_val <- (R_a + G_a - 2 * B_a) / 9
  h_rad <- atan2(b_val, a_val)
  h_ucs <- h_rad*(180.0/pi)
  
  # Calculate Lightness (J)
  e_t <- 0.25 * (cos(h_rad + 2) + 3.8)
  A <-  N_bb * (2*R_a + G_a + 0.05*B_a)
  J <- 100 * ((A / A_w)^(c*z))
  J_ucs <- 1.7 * J / (1 + 0.007 * J)
  
  # Calculate chroma (C)
  t_val <- (5000 / 13 * N_c * N_bb * e_t * sqrt(a_val*a_val + b_val*b_val)) / (R_a + G_a + 1.05 * B_a + 0.305)
  alpha <- t_val^0.9*(1.64 - 0.29^n)^0.73
  C <- alpha * sqrt(J/100)
  
  # Calculate colorfulness (M)
  M <- C * F_L^0.25
  M_ucs <- log(1 + 0.0228 * M) / 0.0228
  
  # Calculate redness-greenness & yellowness-blueness
  a_ucs <- M * cos(h_rad)
  b_ucs <- M * sin(h_rad)
  
  # Return only converted values
  return(tibble(h_ucs, J_ucs, M_ucs, a_ucs, b_ucs)) 
}

nc <- 5
rgb_vals <- tibble(r1 = rdunif(nc, b=255, a=0), 
                   g1 = rdunif(nc, b=255, a=0), 
                   b1 = rdunif(nc, b=255, a=0))

# Batch processing with pmap
output <- rgb_vals %>%
  mutate(pmap_dfr(., sRGB_to_CAM16UCS))

print(output)
openxlsx::write.xlsx(output, "rgb2camucs.xlsx")

额外优化说明 #

• 重命名了函数内的a、b、t变量为a_val、b_val、t_val，避免与内置函数或外部变量冲突。
• 移除了数值前的多余0（如07.22改为7.22），规范代码格式。
• 用(1/3)替代0.33333333333，提升代码可读性与精度。
• 使用pmap_dfr实现批量处理，比手动循环更高效，符合R向量化编程习惯。

内容的提问来源于stack exchange，提问作者Sushil Kumar Prem