R在嵌套列表中的数字集中重复单个数字



我有一组字母数字矢量:

lst <- list(c("三垣3-19", "6", "81497", "79992", "79101", 
"77760", "75973", "75411", "74666"), c("蒼龍1-01", "2", "66249", "65474", "66803", "64238"), c("蒼龍1-02", "1", "64238"), "蒼龍1-03")
[[1]]
[1] "三垣3-19" "6"        "81497"    "79992"   
[5] "79101"    "77760"    "75973"    "75411"   
[9] "74666"   
[[2]]
[1] "蒼龍1-01" "2"        "66249"    "65474"   
[5] "66803"    "64238"   
[[3]]
[1] "蒼龍1-02" "1"        "64238"   
[[4]]
[1] "蒼龍1-03"

每个矢量上的第二个数字(即6,2,1)表示将恒星连接在一起的线的总数,由其右侧的HIP数给出。每对HIP数字表示在2颗星之间画一条线。

因此,[[1]]中的81497 79992表示"在恒星编号"81497"one_answers"79992"之间划一条线,依此类推

在连续线的情况下,如[[1]],应重复"81497"one_answers"74666"之间的数字,以使线中没有中断。

因此,在[[1]]的情况下,应重复"79992" "79101" "77760" "75973" "75411"以给出以下结果:

[[1]]
[1] "三垣3-19" "6"        "81497"    "79992"   
[5] "79992"    "79101"    "79101"    "77760"   
[9] "77760"    "75973"    "75973"    "75411"   
[13] "75411"    "74666"   
[[2]]
[1] "蒼龍1-01" "2"        "66249"    "65474"   
[5] "66803"    "64238"   
[[3]]
[1] "蒼龍1-02" "1"        "64238"    "64238"   
[[4]]
[1] "蒼龍1-03"

由于每个列表上的第二个元素表示要绘制的行的总数,因此可以对有效性测试进行编码,以指示是否需要重复某些数字。因此,[[1]]中的6意味着后面应该有6对HIP数(即6*2=12个元素)。当有效性测试失败时,我希望R为我重复第三个和最后一个元素之间的数字,这样就可以画出连续的线。


我设法拼凑出的部分解决方案如下:

lapply(lst, function(x) x[2]) == (lengths(lst)-2)/2
[1] FALSE  TRUE FALSE    NA

这将测试HIP值的有效性。只有[[2]]符合原始列表中的描述。[[1]][[3]]将是我们需要研究的矢量

要在某个向量之间重复单个值,我可以这样做:

> x <- c(1,2,3,4,5)
> x[2:4] <- lapply(x[2:4], function(x) rep(x, 2))
> unlist(x)
[1] 1 2 2 3 3 4 4 5

但是,因为lst是一个列表,所以我不能做:

lst[2:4] <- lapply(lst[2:4], function(x) rep(x, 2))

以获得相同的结果。端号(在这种情况下为4)需要由lengths(lst)指定,这一事实使问题更加复杂。

我想最后的代码将是一个ifelse()函数来连接上面描述的两个函数。


规则澄清:

每个矢量的第二个元素表示绘制一条线所需的不同HIP对的数量。

[[2]]是有效的,因为后面有两对数字,这符合其第二个元素中给定的值,所以这些数字不需要重复。

在这种情况下,这些线很可能形成一个十字,而不是一条连续的线。因此,该规则应仅适用于连续线的情况,例如[[1]]

至于[[3]]的情况,因为只有一个点,所以作为规则,数字是重复的,从而维持第二个元素给出的有效性。


BUG查询

@TUSHAr:当矢量中的元素包含非数值时,您的代码似乎会生成NA值。

lst <- list(c("三垣3-19", "6", "81497", "79992A", "79101", 
"77760", "75973A", "75411", "74666"), c("蒼龍1-01", "2", "66249", "65474", "66803B", "64238"), c("蒼龍1-02", "1", "64238"), "蒼龍1-03")

用上面的数据运行代码,你会得到:

[[1]]
[1] "三垣3-19" "6"        "81497"    NA         NA        
[6] "79101"    "79101"    "77760"    "77760"    NA        
[11] NA         "75411"    "75411"    "74666"   
[[2]]
[1] "蒼龍1-01" "2"        "66249"    "65474"    NA        
[6] "64238"   
[[3]]
[1] "蒼龍1-02" "1"        "64238"    "64238"   
[[4]]
[1] "蒼龍1-03"

是什么导致了这种情况,有办法解决吗?

lst中每个vector的第一个值存储在单独的变量id中,以避免处理过程中不必要的子设置。

id = lapply(lst,function(t){t[1]})

删除了已存储在id中的第一个元素。

lst = lapply(lst,function(t){
t=t[-1]
#if(length(t)>0){
#    as.integer(t)
#}
})

循环通过已处理的lst对象:

temp = lapply(lst,function(t){
#Use the first value as the desired number of pairs in `reqdpairs`
reqdpairs = as.numeric(t[1])
#remove the first values so that `t` only contains HIP numbers.
t=t[-1]
#calculate existing number of pairs for case [[2]] such that if all conditions are satisfied we don't do any processing 
noofpairs = floor(length(t)/2)
#check if `t` contains values after removing the first element. The `else` part covers the case [[3]]
if(length(t)>1){
#If `noofpairs` is not equal to `reqdpairs` use `rep` on the inner elements (**excluding the first and last element**) of the vector.
if(noofpairs!=reqdpairs){
pairs=c(reqdpairs,t[1],rep(t[-c(1,length(t))],each=2),t[length(t)])
}else{
#In this case no processing is required so we just merge the reqdpairs with `t` as it is
pairs=c(reqdpairs,t)
}
}else if(length(t)==1){
pairs=rep(t[1],times=2) 
pairs=c(reqdpairs,pairs)
}else{
pairs=NULL
}
pairs=as.character(pairs)
}
)

该步骤是将idtemp合并以实现所需的输出格式。基本上只是一个串联步骤。

mapply(function(x,y){c(x,y)},id,temp)

#[[1]]
#[1] "三垣3-19" "6"        "81497"    "79992"    "79992"    "79101"    "79101"    "77760"    "77760"    "75973"   
#[11] "75973"    "75411"    "75411"    "74666"   
#[[2]]
#[1] "蒼龍1-01" "2"        "66249"    "65474"    "66803"    "64238"   
#[[3]]
#[1] "蒼龍1-02" "1"        "64238"    "64238"   
#[[4]]
#[1] "蒼龍1-03"

最新更新