4

たとえば、著者と本をマップする SQL テーブルがあります。リンクされた著者と本 (同じ著者が書いた本、および本を共同執筆した著者) をグループ化し、これらのグループがどのくらい大きくなるかを確認したいと思います。たとえば、JK ローリングがジュノット ディアスと共同執筆し、ジュノット ディアスがザディ スミスと共同で本を執筆した場合、3 人の著者全員が同じグループに属することを望みます。

ここに、私が話している関係のいくつかを含むおもちゃのデータセット (h/t Matthew Dowle) があります。

set.seed(1)
authors <- replicate(100,sample(1:3,1))
book_id <- rep(1:100,times=authors)
author_id <- c(lapply(authors,sample,x=1:100,replace=FALSE),recursive=TRUE)
aubk <- data.table(author_id = author_id,book_id = book_id)
aubk[order(book_id,author_id),]

ここでは、著者 27 と 36 がブック 2 を共同執筆したことがわかります。したがって、彼らは同じグループに属しているはずです。3 の著者 63 と 100 についても同じです。4 の場合は D、F、L などです。

(ご想像のとおり) 遅い for ループ以外に、これを行う良い方法は思いつきません。data.table不必要なコピーを避けるために、少し試してみました。それを行うより良い方法はありますか？

aubk$group <- integer(dim(aubk)[1])
library(data.table)
aubk <- data.table(aubk)
#system.time({
for (x in 1:dim(aubk)[1]) {
    if(identical(x,1)) {
        value <- 1L
    } else {
        sb <- aubk[1:(x-1),]
        index <- match(aubk[x,author_id],sb[,author_id])
        if (identical(index,NA_integer_)) {
            index <- match(aubk[x,book_id],sb[,book_id])
            if (identical(index,NA_integer_)) {
                value <- x
            } else {
                value <- aubk[index,group]
            }
        } else {
            value <- aubk[index,group]
        }
    }
    aubk[x,group:=value]
}
#})

編集: @Josh O'Brien と @thelatemail で述べたように、私の問題は、すべてのエッジが行であり、2 つの列が接続されたノードである 2 列のリストからグラフの接続されたコンポーネントを探すこととして表現することもできます。 .

4

3 に答える 3

3

500K ノードを隣接行列に変換することは、コンピューターのメモリにとっては多すぎたため、使用できませんでしigraphた。パッケージはRBGLR バージョン 2.15.1 用に更新されていないため、それもアウトでした。

うまくいかないように見える多くのばかげたコードを書いた後、次のようにすると正しい答えが得られると思います。

aubk[,grp := author_id]
num.grp.old <- aubk[,length(unique(grp))]
iterations <- 0
repeat {
    aubk[,grp := min(grp),by=author_id]
    aubk[,grp := min(grp), by=book_id]
    num.grp.new <- aubk[,length(unique(grp))] 
    if(num.grp.new == num.grp.old) {break}
    num.grp.old <- num.grp.new
    iterations <- iterations + 1
}
于 2012-10-18T05:50:21.947 に答える
1

Josh O'Brienがコメントでリンクした私の古い質問に対する私の答えを再ハッシュします（一緒に連鎖するリンクされたエピソードのグループを特定します）。この回答はigraphライブラリを使用しています。

# Dummy data that might be easier to interpret to show it worked
# Authors 1,2 and 3,4 should group. author 5 is a group to themselves
aubk <- data.frame(author_id=c(1,2,3,4,5),book_id=c(1,1,2,2,5))

# identify authors with a bit of leading text to prevent clashes 
# with the book ids
aubk$author_id2 <- paste0("au",aubk$author_id)

library(igraph)
#create a graph - this needs to be matrix input
au_graph <- graph.edgelist(as.matrix(aubk[c("author_id2","book_id")]))
# get the ids of the authors
result <- data.frame(author_id=names(au_graph[1]),stringsAsFactors=FALSE)
# get the corresponding group membership of the authors
result$group <- clusters(au_graph)$membership

# subset to only the authors data
result <- result[substr(result$author_id,1,2)=="au",]
# make the author_id variable numeric again
result$author_id <- as.numeric(substr(result$author_id,3,nchar(result$author_id)))

> result
  author_id group
1         1     1
3         2     1
4         3     2
6         4     2
7         5     3
于 2012-09-28T21:01:45.193 に答える
0

いくつかの提案

aubk[,list(author_list = list(sort(author_id))), by = book_id]

著者グループのリストが表示されます

以下は、著者のグループごとに一意の識別子を作成し、次のリストを返します。

  • 本の数
  • ブックIDのリスト
  • book_idsの一意の識別子
  • 著者の数

著者のユニークなグループごとに

aubk[, list(author_list = list(sort(author_id)), 
            group_id = paste0(sort(author_id), collapse=','), 
            n_authors = .N),by =  book_id][,
        list(n_books = .N, 
             n_authors = unique(n_authors), 
             book_list = list(book_id), 
             book_ids = paste0(book_id, collapse = ', ')) ,by = group_id]

著者の順序が重要な場合は、とsortの定義を削除してくださいauthor_listgroup_id

編集

上記は有用ですが、適切なグループ化を行わないことに注意してください

おそらく次のようになります

# the unique groups of authors by book
unique_authors <- aubk[, list(sort(author_id)), by = book_id]
# some helper functions
# a filter function that allows arguments to be passed
.Filter <- function (f, x,...) 
{
  ind <- as.logical(sapply(x, f,...))
  x[!is.na(ind) & ind]
}

# any(x in y)?
`%%in%%` <- function(x,table){any(unlist(x) %in% table)}
# function to filter a list and return the unique elements from 
# flattened values
FilterList <- function(.list, table) {
  unique(unlist(.Filter(`%%in%%`, .list, table =table)))
}

# all the authors
all_authors <- unique(unlist(unique_authors))
# with names!
setattr(all_authors, 'names', all_authors)
# get for each author, the authors with whom they have
# collaborated in at least 1 book
lapply(all_authors, FilterList, .list = unique_authors)
于 2012-09-28T00:15:15.750 に答える