Question

我在R.工作。我有一个数据框，其中包含染色体上的起始位置和结束位置（整数表示染色体上的坐标）例如：

start     end
1         5
3         7
4         10
12        7            (inverted is also allowed)
8         15

我想要的是计算所有这些范围内坐标的出现次数。因此，对于上面的示例，输出将是：

position     count
1            1
2            1
3            2
4            3
5            3
6            2
7            3
8            3
9            3
10           3
11           2
12           2
13           1
14           1
15           1

我有62000多个这样的范围，每个范围至少有1000个位置。我知道如何进行这种转换，但我不知道如何有效地完成这项工作，即几秒钟。

当前（效率低下的代码）

positions <- c()
for(i in seq(nrow(a))){
  positions <- c(positions, seq(a[i,3], a[i,4]))
}
table(positions)

“a”是我的数据框，起点和终点坐标分别在第三和第四列。

数据框中的一列包含字符，因此对于使用apply，我要么需要创建一个新的数据框（消耗额外的空间），要么需要在apply函数内转换为整数（额外的时间）。对不起，因为之前没有告知此事。

Answer 1

对于<script src="https://ajax.googleapis.com/ajax/libs/jquery/2.1.1/jquery.min.js"></script> <div class="button"> button</div> <div class="button"> button</div> <div class="button"> button</div> <div class="button_place">button_place</div> <div class="button_place">button_place</div> <div class="button_place">button_place</div>的非常快的代码，请参阅 docendo discimus 的答案（+基准）

以下是其他一些解决方案的基准：

@TabFactory("pages.properties.label")
public void pageProperties(UiConfig cfg, TabBuilder tab) {

    List<String> targetGroup = new ArrayList<>();
    targetGroup.add(new OptionBuilder().value("Group A").label("Group A").selected());
    targetGroup.add(new OptionBuilder().value("Group B").label("Group B").selected());

    List<String> menuTeaser = new ArrayList<>();
    menuTeaser.add(new OptionBuilder().value("Group A").label("Teaser A").selected());
    menuTeaser.add(new OptionBuilder().value("Group A").label("Teaser B").selected());

    tab.fields(
        cfg.fields.text("pageTitle").label("pages.properties.pageTitle.label").i18n()
            .description("pages.properties.pageTitle.description").i18n()
            .defaultValue("any value").i18n()   // works!
            .requiredErrorMessage("pages.properties.pageTitle.requiredErrorMessage").i18n()
            .required(),

        cfg.fields.select("targetGroup").label("pages.properties.targetGroup.label").i18n()
            .description("pages.properties.targetGroup.description").i18n()
            .options(targetGroup.toArray(new OptionBuilder[targetGroup.size()])).i18n(),

        cfg.fields.optionGroup("menuTeaser").label("pages.properties.menuTeaser.label").i18n()
            .description("pages.properties.menuTeaser.description").i18n()
            .options(menuTeaser.toArray(new OptionBuilder[menuTeaser.size()])).i18n()
            .required(),
    );
}

data.table的解决方案会产生警告。

Answer 2

一个想法，

http://www.dn.pt/pesquisa.html?q=economia%20empresas

Answer 3

这与您使用的算法大致相同，但应该更快。

myNums <- unlist(lapply(seq_len(nrow(df)), function(i) seq(df$start[i], df$end[i])))

table(myNums)
myNums
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 
 1  1  2  3  3  2  3  3  3  3  2  2  1  1  1

更快的方法是使用tabulate而不是table。例如，

temp <- unlist(lapply(seq_len(nrow(df)), function(i) seq(df$start[i], df$end[i])))
cbind(sort(unique(temp)), tabulate(temp))

返回矩阵

      [,1] [,2]
 [1,]    1    1
 [2,]    2    1
 [3,]    3    2
 [4,]    4    3
 [5,]    5    3
 [6,]    6    2
 [7,]    7    3
 [8,]    8    3
 [9,]    9    3
[10,]   10    3
[11,]   11    2
[12,]   12    2
[13,]   13    1
[14,]   14    1
[15,]   15    1

对于给定的数据集，

运行速度提高约50％。

Unit: microseconds
     expr     min       lq     mean   median       uq     max neval cld
    table 223.233 237.6305 250.0329 245.8985 253.4545 423.944   100   b
 tabulate 142.835 159.0860 166.9775 167.3540 175.7650 195.009   100  a

Answer 4

我会提出一个data.table解决方案，因为我们对性能感兴趣。方法如下：

library(data.table)
setDT(df)
df[, list(seq.int(start, end)), by = 1:nrow(df)][, .N, by = V1]

尽管采用行式操作，但与其他解决方案相比，它的表现非常好。

以下是 1e4 行的基准：

set.seed(42)
N <- 1e4
vals = 1:100
df <- data.frame(start=sample(vals, N, replace = TRUE), end = sample(vals, N, replace = TRUE))
library(data.table)
library("microbenchmark")
dt <- copy(df)
setDT(dt)

microbenchmark(unit = "relative", times = 10,
               jogo = table(unlist(Map(seq, df$start, df$end))),           # jogo
               sotos = table(unlist(Map(':', df$start, df$end))),           # Sotos
               lmo  = table(unlist(lapply(seq_len(nrow(df)), function(i) seq(df$start[i], df$end[i])))),    # lmo
               orig_989  = table(do.call(c, mapply(seq, df$start, df$end))),     # @989 (comment to the answer from Sotos)
               mod_989  = table(do.call(c, mapply(seq.int, df$start, df$end))), # docendo discimus (comment to this answer)
               dd = dt[, list(seq.int(start, end)), by = 1:nrow(dt)][, .N, by = V1]
)

Unit: relative
     expr       min        lq      mean    median        uq       max neval cld
     jogo  8.794179  8.735461 19.226146  8.584978  8.637774 52.782168    10  ab
    sotos 10.669810 10.623685  8.984351 10.437937 10.164045  4.846189    10  ab
      lmo 21.319154 21.117393 27.452902 22.558436 22.913901 43.403024    10   b
 orig_989  9.190209  8.725191  7.532509  8.730023  8.516305  3.948500    10  ab
  mod_989  5.372087  5.097636  5.067462  5.305532  6.214493  3.188091    10  ab
       dd  1.000000  1.000000  1.000000  1.000000  1.000000  1.000000    10  a

Answer 5

我为fastcgi_param QUERY_STRING $query_string; fastcgi_param REQUEST_METHOD $request_method; fastcgi_param CONTENT_TYPE $content_type; fastcgi_param CONTENT_LENGTH $content_length; fastcgi_param SCRIPT_FILENAME $request_filename; fastcgi_param SCRIPT_NAME $fastcgi_script_name; fastcgi_param REQUEST_URI $request_uri; fastcgi_param DOCUMENT_URI $document_uri; fastcgi_param DOCUMENT_ROOT $document_root; fastcgi_param SERVER_PROTOCOL $server_protocol; fastcgi_param GATEWAY_INTERFACE CGI/1.1; fastcgi_param SERVER_SOFTWARE nginx/$nginx_version; fastcgi_param REMOTE_ADDR $remote_addr; fastcgi_param REMOTE_PORT $remote_port; fastcgi_param SERVER_ADDR $server_addr; fastcgi_param SERVER_PORT $server_port; fastcgi_param SERVER_NAME $server_name; fastcgi_param HTTPS $https if_not_empty; fastcgi_param REDIRECT_STATUS 200; fastcgi_param HTTP_PROXY ""; fastcgi_param HTTP_AUTHORIZATION $http_authorization; fastcgi_param OAUTH_TOKEN $http_oauth_token; fastcgi_param OAUTH_TOKEN_SECRET $http_oauth_token_secret;中的每一行创建了一个序列，例如第一行df。使用：

c(1,2,3,4,5)

表格将计算all.pos <- apply(df, 1, function(x){x[1]:x[2]}) all.pos <- unlist(all.pos) # 1 2 3 4 5 3 4 5 6 7 4 5 6 7 8 9 10 12 11 10 9 8 7 8 9 # 10 11 12 13 14 15中每个职位的出现频率。

all.pos

Answer 6

另一种避免table的方法，循环遍历范围并每次向相关值添加1 ......

ranges <- data.frame(start=c(1,3,4,12,8), end=c(5,7,10,7,15) )

pos <- data.frame(x=(min(ranges):max(ranges)),n=0)

for(i in seq_along(ranges$start)){
  low=min(ranges$start[i])-pos$x[1]+1
  high=max(ranges$end[i])-pos$x[1]+1
  pos$n[low:high] <- pos$n[low:high]+1
}

pos
    x n
1   1 1
2   2 1
3   3 2
4   4 3
5   5 3
6   6 2
7   7 3
8   8 3
9   9 3
10 10 3
11 11 2
12 12 2
13 13 1
14 14 1
15 15 1

Answer 7

首先出现的可能不是最好的，但通过使用应用的东西应该会更快。

df <- data.frame(start=c(1,3,4,12,8), end=c(5,7,10,7,15) )

positions <- apply(df, 1, function (x) {
  seq(x[1], x[2])
})

table(unlist(positions))

产量..

 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 
 1  1  2  3  3  2  3  3  3  3  2  2  1  1  1

将数据帧中的范围集转换为单个元素的频率的有效方法？

7 个答案: