按组生成多个组的选择切换矩阵

3
我想先通过对(下面代码中的用户)进行计算来计算选择切换概率。 然后,我将平均组级概率并得到总概率。 我有数万个组,因此需要快速的代码。 我的代码是一个for循环,需要超过10分钟才能运行。 我用相同的代码/逻辑在Excel中进行操作,只需要几秒钟。
对于特定用户的选择m到n的切换被定义为选择在期间t-1时是m且在期间t时是n的观测占比。 我的原始代码首先通过for循环标记第一次和最后一次购买。然后使用另一个for循环获取切换矩阵。 我只能通过整个数据而不是通过组创建切换矩阵。 即使这样,它仍然非常缓慢。 添加用户将使其变得更慢。
    t<-c(1,2,1,1,2,3,4,5)
    user<-c('A','A','B' ,'C','C','C','C','C')
    choice<-c(1,1,2,1,2,1,3,3)
    dt<-data.frame(t,user,choice)

    t user choice
    1   A   1
    2   A   1
    1   B   2
    1   C   1
    2   C   2
    3   C   1
    4   C   3
    5   C   3


    # **step one** create a second choice column for later construction of the switching matrix
    #Label first purchase and last purchase is zero
       for (i in 1:nrow(dt))
     { ifelse (dt$user[i+1]==dt$user[i],dt$newcol[i+1]<-0,dt$newcol[i+1]<-1) }


    # **step two** create stitching matrix 
    # switching.m is a empty matrix with the size of total chocie:3x3 here
  length(unique(dt$user))
total.choice<-3
switching.m<-matrix(0,nrow=total.choice,ncol=total.choice)

  for (i in 1:total.choice)
    {
    for(j in 1:total.choice)
      {
      if(length(nrow(switching.m[switching.m[,1]==i& switching.m[,2]==j,])!=0))
      {switching.m[i,j]=nrow(dt[dt[,1]==i&dt[,2]==j,])}

    else {switching.m[i,j]<0}
      }
  }

特定用户/组的期望输出应如下。即使用户没有作出特定选择,输出也应具有相同的矩阵大小。

# take user C

#output for switching matrix
            second choice  
    first   1 2 3
    1       0 1 1
    2       1 0 0        
    3       0 0 1       

#output for switching probability
            second choice  
    first   1   2    3
    1       0 0.5 0.5
    2       1 0    0        
    3       0 0    1       

@akrun,代码已添加。 - Jim
由于某些原因,您的代码正在抛出错误。请检查括号。 - akrun
2
也许可以尝试使用 lapply(split(dt$choice,dt$user),function(x) table(x[-length(x)],x[-1])) - nicola
@akrun,现在代码应该可以工作了。我无法按组生成它,只能通过整个数据集来完成。 - Jim
尝试先拆分fir,然后使用df%>% group_by(user)%>% mutate(Flag = as.integer(row_number()<2))进行操作。之后,您可以使用nrow构建矩阵。 - MLE
1个回答

3
我们可以在以“user”为分割点之后,使用tableprop.table
lst <- lapply(split(dt, dt$user), function(x)
     table(factor(x$choice, levels= 1:3), factor(c(x$choice[-1], NA), levels=1:3)))

正如@nicola所提到的,更好的做法是按照'user'分割'choice'列。

lst <- lapply(split(dt$choice, dt$user), function(x) 
       table(factor(x, levels = 1:3), factor(c(x[-1], NA), levels = 1:3))) 

lst$C

#  1 2 3
#1 0 1 1
#2 1 0 0
#3 0 0 1


prb <- lapply(lst, prop.table, 1)
prb$C

#     1   2   3
#  1 0.0 0.5 0.5
#  2 1.0 0.0 0.0
#  3 0.0 0.0 1.0

基本上是我在评论区同时发布的相同内容 :) +1 - nicola
@nicola 抱歉,在发布这个帖子时我没有看到你的评论。可能是页面没有更新,而我正在忙着发布这个帖子。 - akrun
1
别担心,你做不到。我们同时完成了这个任务。你只需要分割 dt$choice 而不是整个 data.frame 来提高效率(分割更轻便,在 lapply 中也不需要 $ 子集操作)。 - nicola

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接