循环遍历函数参数(与 multcomp::glht 的一系列对比)

发布于 2025-01-18 02:40:49 字数 2138 浏览 1 评论 0原文

我想编写一个通过回归模型进行对比的函数,并引导这些结果获得置信区间,从而在对比度列表中循环函数。

我已经尝试了嵌套在功能中的循环,lapply,映射...似乎没有什么能让我得到我想要的东西(仅列表中的第一个对比度或最后一个对比度的返回结果)。

对于对比列表的单一对比,该代码看起来像这样:

df <- data.frame(

  H0013301_new_data = c(0,2,3,6,0,4,2,4,8,1),
  drink_stat94_KEYES_2 = c("Heavy","Abstainer","Occasional","Moderate","Abstainer","Occasional","Heavy","Moderate","Moderate","Abstainer"),
  drink_stat02_KEYES_2 = c("Heavy","Abstainer","Occasional","Abstainer","Abstainer","Heavy","Heavy","Moderate","Moderate","Abstainer"),
  drink_stat06_KEYES_2 = c("Occasional","Abstainer","Occasional","Abstainer","Occasional","Heavy","Heavy","Moderate","Moderate","Heavy"),
FIN_weight_survPS_trimmed=
c(.5,2.4,.6,4.8,1.2,.08,.34,.56,1.6,.27)
)

#reordering factors
df$drink_stat94_KEYES_2<-fct_relevel(df$drink_stat94_KEYES_2, "Abstainer", "Occasional", "Moderate", "Heavy")
contrasts(df$drink_stat94_KEYES_2)<-contr.treatment(4,base=1)
df$drink_stat02_KEYES_2<-fct_relevel(df$drink_stat02_KEYES_2, "Abstainer", "Occasional", "Moderate", "Heavy")
contrasts(df$drink_stat02_KEYES_2)<-contr.treatment(4,base=1)
df$drink_stat06_KEYES_2<-fct_relevel(df$drink_stat06_KEYES_2, "Abstainer", "Occasional", "Moderate", "Heavy")
contrasts(df$drink_stat06_KEYES_2)<-contr.treatment(4,base=1)



#defining contrast
c1 <- rbind("A,A,A"=c(1,0,0,0,0,0,0,0,0,0)
                ) 

#defining function to feed to boostrap
fc_2<-function(d,i){
 TrialOutcomeModel_M<-lm(H0013301_new_data ~ drink_stat94_KEYES_2 + drink_stat02_KEYES_2 + drink_stat06_KEYES_2, weights=FIN_weight_survPS_trimmed, data = d[i,]) 
 test <- multcomp::glht(TrialOutcomeModel_M, linfct=c1) 
 return(coef(test))
}
boot_out<-boot(data=df, fc_2, R=500) 
boot.ci(boot_out, type="perc")

但是假设我不仅仅是C1,我想在以下对比度列表中运行我的函数(并boostrap the结果):

c1 <- rbind("A,A,A"=c(1,0,0,0,0,0,0,0,0,0)
                ) 
c2 <- rbind("A,A,O"=c(1,0,0,0,0,0,0,1,0,0)
                ) 
c3 <- rbind("A,A,M"=c(1,0,0,0,0,0,0,0,1,0)
                ) 

c_vector<-list(c1,c2,c3)

任何建议的代码会这样吗? (PS我知道LINFCT参数可以采用对比的矩阵,但我专门寻找循环/lapply解决方案)。

I wish to write a function that runs contrasts over a regression model and bootstraps those results to get confidence intervals, looping that function over a list of contrasts.

I have tried for loops nested within functions, lapply, map ... none seem to get me what I want (returns results for either only the first contrast in the list or the last).

For a single contrast from the list of contrasts, the code looks like this:

df <- data.frame(

  H0013301_new_data = c(0,2,3,6,0,4,2,4,8,1),
  drink_stat94_KEYES_2 = c("Heavy","Abstainer","Occasional","Moderate","Abstainer","Occasional","Heavy","Moderate","Moderate","Abstainer"),
  drink_stat02_KEYES_2 = c("Heavy","Abstainer","Occasional","Abstainer","Abstainer","Heavy","Heavy","Moderate","Moderate","Abstainer"),
  drink_stat06_KEYES_2 = c("Occasional","Abstainer","Occasional","Abstainer","Occasional","Heavy","Heavy","Moderate","Moderate","Heavy"),
FIN_weight_survPS_trimmed=
c(.5,2.4,.6,4.8,1.2,.08,.34,.56,1.6,.27)
)

#reordering factors
df$drink_stat94_KEYES_2<-fct_relevel(df$drink_stat94_KEYES_2, "Abstainer", "Occasional", "Moderate", "Heavy")
contrasts(df$drink_stat94_KEYES_2)<-contr.treatment(4,base=1)
df$drink_stat02_KEYES_2<-fct_relevel(df$drink_stat02_KEYES_2, "Abstainer", "Occasional", "Moderate", "Heavy")
contrasts(df$drink_stat02_KEYES_2)<-contr.treatment(4,base=1)
df$drink_stat06_KEYES_2<-fct_relevel(df$drink_stat06_KEYES_2, "Abstainer", "Occasional", "Moderate", "Heavy")
contrasts(df$drink_stat06_KEYES_2)<-contr.treatment(4,base=1)



#defining contrast
c1 <- rbind("A,A,A"=c(1,0,0,0,0,0,0,0,0,0)
                ) 

#defining function to feed to boostrap
fc_2<-function(d,i){
 TrialOutcomeModel_M<-lm(H0013301_new_data ~ drink_stat94_KEYES_2 + drink_stat02_KEYES_2 + drink_stat06_KEYES_2, weights=FIN_weight_survPS_trimmed, data = d[i,]) 
 test <- multcomp::glht(TrialOutcomeModel_M, linfct=c1) 
 return(coef(test))
}
boot_out<-boot(data=df, fc_2, R=500) 
boot.ci(boot_out, type="perc")

But let's assume that instead of just c1, I want to run my function (and boostrap the results) over the following list of contrasts:

c1 <- rbind("A,A,A"=c(1,0,0,0,0,0,0,0,0,0)
                ) 
c2 <- rbind("A,A,O"=c(1,0,0,0,0,0,0,1,0,0)
                ) 
c3 <- rbind("A,A,M"=c(1,0,0,0,0,0,0,0,1,0)
                ) 

c_vector<-list(c1,c2,c3)

Any suggested code for how I would go about this?
(P.S. I know that the linfct argument can take a matrix of contrasts, but I'm specifically looking for a loop/lapply solution).

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

哭了丶谁疼 2025-01-25 02:40:49

(在以下内容中,我将在示例代码中引用您创建的对象)

plan 有2个步骤:

  1. 准备函数fun_boot()进行对比度对象(例如c1),并基于它返回boot对象,df data;

  2. 将该功能应用于列表C_Vector对比度。

因此,实施有2个要素:

# [!] Assume all required libraries loaded
# [!] Assume all necessary data exists

# Step 1
fun_boot <- function(contrast)
{
    # Make statistic function
    fun_statistic <- function(d, i)
    {
        TrialOutcomeModel_M <- lm(
           formula = H0013301_new_data ~ drink_stat94_KEYES_2 + drink_stat02_KEYES_2 + drink_stat06_KEYES_2,
           data    = d[i,],
           weights = FIN_weight_survPS_trimmed
        ) 
        test <- multcomp::glht(
           TrialOutcomeModel_M,
           linfct = contrast
        )
        return(coef(test))
    }

    # Make boot call (hehe)
    return (boot(
       data      = df,
       statistic = fun_statistic,
       R         = 500
    ))
}

# Step 2
boot_out_vector <- lapply(
   X   = c_vector,
   FUN = fun_boot
)

(In the following I'll reference the objects you create in the example code)

The plan has 2 steps:

  1. preparing a function fun_boot() that takes a contrast object (like c1), and returns a boot object based on it and the df data;

  2. applying that function to the list c_vector of contrasts.

Consequently, the implementation has 2 elements:

# [!] Assume all required libraries loaded
# [!] Assume all necessary data exists

# Step 1
fun_boot <- function(contrast)
{
    # Make statistic function
    fun_statistic <- function(d, i)
    {
        TrialOutcomeModel_M <- lm(
           formula = H0013301_new_data ~ drink_stat94_KEYES_2 + drink_stat02_KEYES_2 + drink_stat06_KEYES_2,
           data    = d[i,],
           weights = FIN_weight_survPS_trimmed
        ) 
        test <- multcomp::glht(
           TrialOutcomeModel_M,
           linfct = contrast
        )
        return(coef(test))
    }

    # Make boot call (hehe)
    return (boot(
       data      = df,
       statistic = fun_statistic,
       R         = 500
    ))
}

# Step 2
boot_out_vector <- lapply(
   X   = c_vector,
   FUN = fun_boot
)
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文