Блог

Я хочу выполнить регрессию с передачей Bablock, выполнив a group_by() , что позволило бы мне выполнить регрессию параметров P1 4 машин ( MACHINE столбца) с P1_ref помощью , и сделать то же самое для P2 и P2_ref .

 require(mcr)
df_reg <- cbind(MACHINE = c("M1", "M1", "M1", "M1", "M1", "M1", "M1" ,"M1", "M1" ,"M1", "M2",
                            "M2", "M2", "M2", "M2", "M2", "M2", "M2" ,"M2", "M2", "M3", "M3",
                            "M3", "M3", "M3", "M3", "M3", "M3", "M3", "M3", "M4", "M4" ,"M4",
                            "M4", "M4", "M4", "M4", "M4", "M4", "M4"),
                P1 = c(2.09 ,3.71, 4.71, 4.30, 4.45, 3.29, 1.96, 3.01, 3.33, 3.30, 2.06, 3.81, 4.53,
                       4.55, 4.62, 3.51, 2.01, 3.08, 3.53, 3.48, 2.06, 3.74, 4.60, 4.41, 4.46, 3.37,
                       1.95, 3.00, 3.25, 3.32, 2.06, 3.78, 4.55, 4.29, 4.47, 3.29, 1.91, 2.92, 3.23,
                       3.22),
                P2 = c(6.16,4.28, 4.62,  1.21,  7.09,  7.82, 10.84,  3.50,  2.98,  2.70,  6.15,  4.45,
                4.77,  1.90,  7.94,  8.07,11.13,  3.65,  3.33,  2.78,  6.05,  4.34,  4.60,  1.85,
                7.89,  8.10, 11.72,  3.79,  3.20,  2.91,  6.16,4.47,4.66,  1.85,  7.78,  7.96, 11.16,
                3.63,3.24,2.88),
                MACHINE_REF = c("REF", "REF" ,"REF", "REF", "REF" ,"REF", "REF", "REF", "REF", "REF", 
                                "REF", "REF" ,"REF", "REF", "REF" ,"REF",
                                "REF", "REF", "REF", "REF", "REF", "REF", "REF" ,"REF", "REF", "REF", "REF", "REF", "REF",
                                "REF" ,"REF", "REF","REF", "REF", "REF", "REF" ,"REF", "REF",
                                "REF", "REF"),
                P1_ref = c( 1.935, 3.735, 4.765, 4.505, 4.680, 3.385, 1.885, 2.935, 3.350, 3.290,
                            1.935, 3.735, 4.765, 4.505, 4.680, 3.385,1.885, 2.935, 3.350, 3.290,
                            1.935, 3.735, 4.765, 4.505, 4.680, 3.385, 1.885 ,2.935, 3.350, 3.290,
                            1.935, 3.735, 4.765 ,4.505, 4.680, 3.385, 1.885, 2.935, 3.350, 3.290),
                P2_ref = c( 6.255, 4.700,  4.945,  2.055,  8.430,  9.130, 12.155,  3.990,  3.715,
                            3.285 , 6.255,  4.700,  4.945,  2.055,8.430,  9.130, 12.155 , 3.990,
                            3.715 , 3.285,  6.255,  4.700,  4.945,  2.055,  8.430,  9.130, 12.155,
                            3.990,3.715,  3.285,  6.255,  4.700,  4.945,  2.055,  8.430,  9.130,
                            12.155,  3.990,  3.715,  3.285)) %>% data.frame

df_reg <- df_reg %>%
  mutate_at(vars(-MACHINE, -MACHINE_REF), as.character)

df_reg <- df_reg %>%
  mutate_at(vars(-MACHINE, -MACHINE_REF), as.numeric)

M1 <- df_reg %>%
  filter(MACHINE %like% "M1") %>%
  drop_na(MACHINE)

M2 <- df_reg %>%
  filter(MACHINE %like% "M2") %>%
  drop_na(MACHINE)
  

Я помещаю каждую машину в список, а параметры машин и ссылку в 2 разных векторах.

 to_numeric_f <- function(df,...){
  df <- df %>% mutate_at(vars(...),as.character)
  df <- df %>% mutate_at(vars(...), as.numeric)
  df
}
df <- to_numeric_f(df, -1,-4)

M_list <- vector("list")
for(i in 1:length(names(table(df$MACHINE)))){
  M_list[[i]] <- df %>%
    filter(MACHINE ==names(table(df$MACHINE))[i])
}
params_M <- colnames(df)[c(2,3)]
params_ref <- colnames(df)[c(5,6)]
fit_paba <- vector("list")
for(i in 1:length(M_list)){
  fit_paba[[i]] <- vector("list")
  for(j in 1:length(params_ref)){
    fit_paba[[i]][[j]] <-  mcreg(M_list[[i]][,params_ref[j]],
                                   M_list[[i]][,params_M[j]], method.reg = "PaBa")
  }
  
}