Как быстро узнать, являются ли два (больших) фактора ретрансляцией друг друга?

Question

У меня есть два вектора факторов и подозреваю, что они несут ту же информацию до перемаркировки. Как я могу узнать, правильно ли это?

Моя проблема в том, что оба вектора довольно длинны (200 000 записей), с большим количеством уровней (4000). Некоторые уровни очень часты, но есть «длинный хвост» уровней, которые появляются только один раз.

Вот воспроизводимый пример (извините, я не мог найти способ компактифицировать его и до сих пор показывают свойства моих данных):

foo <- structure(c(3213L, 428L, 104L, 59L, 23L, 17L, 15L, 9L, 5L, 6L, 
1L, 5L, 3L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Dim = 69L, .Dimnames = structure(list(
    c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
    "12", "13", "14", "15", "16", "23", "33", "83", "205", "246", 
    "255", "319", "374", "379", "389", "552", "566", "595", "686", 
    "750", "846", "965", "999", "1006", "1254", "1514", "1535", 
    "1605", "1687", "1744", "1792", "1937", "1946", "2166", "2198", 
    "2206", "2420", "2503", "2736", "2965", "2986", "3036", "3273", 
    "3734", "4026", "4073", "4279", "5038", "5040", "5185", "5607", 
    "6298", "6609", "6930", "15392", "21083", "22933", "29357" 
    )), .Names = ""), class = "table") 
bar <- as.numeric(rep(names(foo),times=foo)) 
factor.1 <- as.factor(rep(paste0("a",sprintf("%04i",1:length(bar))),times=bar)) 
set.seed(1) 
factor.2 <- as.factor(sample(gsub("a","b",unique(factor.1)),length(unique(factor.1)))[ 
    as.numeric(factor.1)]) 

После этого упражнения, factor.1 и factor.2 просто перемаркировок из друг друга. Итак, как мы можем выяснить, выполняется ли это для новых векторов?

Вещи, которые сделать не работы:

1. Целочисленное кодирование внутренней не должен быть таким же, так просто проверки, является ли cor(as.numeric(factor.1),as.numeric(factor.2))==1 не будет работать.

2. Я пробовал проверять, соответствует ли каждый уровень factor.1 точно одному уровню фактора factor.2 и наоборот. К сожалению, это занимает слишком много времени, порядка нескольких часов:

   foo <- by(factor.1,factor.2,FUN=function(zz)length(unique(zz))) 
   bar <- by(factor.2,factor.1,FUN=function(zz)length(unique(zz))) 
   all(foo) & all(bar) 
   

3. Если мы можем отлично подходит factor.1 в полиномиальной модели с использованием factor.2 в качестве предсказателя, и наоборот, оба несут ту же информацию. К сожалению, nnet::multinom(factor.1~factor.2) дает ужасную ошибку «не может выделить вектор размера XX». randomForest::randomForest(), который, по крайней мере, даст нам вероятностный ответ, не может обрабатывать факторы с более чем 53 уровнями.

4. Мы можем запустить table(factor.1,factor.2) и проверить, имеет ли каждая строка ровно одну ненулевую запись. Который снова заканчивается из памяти.

Answer 1

Первая функция подсчитывает количество уникальных элементов своего аргумента, а вторая возвращает TRUE, если для каждого уровня y существует один уровень x. Если это так для фактора 1 и фактора 2, и если они используют одинаковое количество уровней, то это повторная привязка другой. При данных данных он немедленно возвращается, поэтому кажется довольно быстрым. Последняя строка - это более быстрая версия одной из ваших идей. Используйте один из них.

cnt <- function(x) length(unique(x)) 
all_one <- function(x, y) all(tapply(unclass(x), y, cnt) == 1) 

# solution 1 
all_one(factor.1, factor.2) && cnt(factor.1) == cnt(factor.2) 

# solution 2 
all_one(factor.1, factor.2) && all_one(factor.2, factor.1)