Расчет повторного сотрудничества в R - PullRequest
0 голосов
/ 19 апреля 2020

Создание данных

REPC <- 
  tibble::tribble(
    ~OrganisationID, ~ProjectID,
    22905, 494993,
    9341, 494993,
    877, 504562,
    9221, 504874,
    867, 488182,
    238989, 488182,
    296, 488182,
    270858, 488182,
    867, 181688,
    22905, 181688,
    877, 181688,
    867, 504387,
    877, 504387,    
  )

В настоящее время я пытаюсь рассчитать повторное сотрудничество организаций, для которых мне требуются 2 значения. Сначала я собираюсь рассчитать количество уникальных партнеров по сотрудничеству и количество раз, когда организация сотрудничала с каждым уникальным партнером по сотрудничеству. После этого я хочу рассчитать повторное сотрудничество, которое можно математически выразить как 〖(∏Ri)〗 ^ (1 / N), где Ri - это количество альянсов в области НИОКР, которое было у фокальной фирмы с ее i-м партнером по НИОКР, а N - общее количество партнеров по НИОКР. Например, фирма сотрудничала с 3 уникальными партнерами по сотрудничеству, он сотрудничал с партнером 1, 3 раза, партнером 2, 4 раза, партнером 3, 5 раз. Это приведет к повторному сотрудничеству (3 * 4 * 5) ^ 1/3 = 3,91.

Что я пытаюсь достичь

REPC2 <- 
  tibble::tribble(
    ~OrganisationID, ~NoOfUniqueCollabPartners, ~NoOfCollabswith22905, ~NoOfCollabswith9341, ~NoOfCollabswith877, ~NoOfCollabswith9221, ~NoOfCollabswith867, ~NoOfCollabswith238989, ~NoOfCollabswith270858, ~NoOfCollabswith9221, ~RepeatedCollaboration, 
    22905, 3, NA, 1, 1, 0, 1, 0, 0, 0, 0.33,
    9341, 1, 1, NA, 0, 0, 0, 0, 0, 0, 1,
    877, 2, 1, 0, NA, 0, 2, 0, 0, 0, 1.41,
    9221, 0, 0, 0, 0, NA, 0, 0, 0, 0, NA,
    867, 5, 1, 0, 2, 0, NA, 1, 1, 1, 1.15,
    238989, 3, 0, 0, 0, 0, 1, NA, 1, 1, 0.33,
    270858, 3, 0, 0, 0, 0, 1, 1, NA, 1, 0.33,
    296, 3, 0, 0, 0, 0, 1, 1, 1, NA, 0.33,
  )

Поскольку компания не может сотрудничать сама с собой значения должны быть или NA или ноль.

1 Ответ

0 голосов
/ 19 апреля 2020

Поскольку вы просто запрашиваете два значения, я пропустил матрицу сотрудничества.

Я также сделал предположение, что в вашем tbl.

library(data.table)
library(magrittr)

REPC <- as.data.table(REPC)

arr_org_ID <- unique(REPC[, OrganisationID]) # Array of unique organizations
N_org <- length(arr_org_ID) # Number of unique organizations
lst_proj <- lapply(arr_org_ID, function(id) {REPC[OrganisationID == id, unique(ProjectID)]}) # List of projects involved for each organization
lst_colab <- sapply((seq(N_org)), function(i) { # List of colaborators for each organization (including repeats)
  REPC[
    ProjectID %in% lst_proj[[i]] & OrganisationID != arr_org_ID[i],
    OrganisationID
  ]
})
dt_res <- lapply(seq(N_org), function(i) {
  arr_unique_colab = lst_colab[[i]] %>% unique
  N_unique_colab = arr_unique_colab %>% length # Number of unique collaborators
  # Calculating repeated collaboration ----
  {
    Rep_count = lapply(seq(N_unique_colab), function(j) {
      return(length(which(lst_colab[[i]] == arr_unique_colab[j])))
    }) %>% do.call(prod, .) %>% raise_to_power(1/N_unique_colab)
  }
  # Returning table ----
  {
    return(data.table(OrganisationID = arr_org_ID[i], N_unique_colab, Rep_count))
  }
}) %>% rbindlist
нет повторяющейся строки.

Мне больше нравится синтаксис data.table, поэтому я преобразовал ваш tbl.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...