목록의 목록이 동등한 지 확인하는 더 빠른 방법은 무엇입니까?

9

여기에는 1:7네 개의 다른 파티션, 즉 {1}, {2,3,4}, {5,6} 및 {7}에 대한 정수 가 있으며 해당 파티션은 목록에 작성됩니다 (예 :) list(1,c(2,3,4),c(5,6),7). 파티션을 세트로 취급하므로 한 파티션 내에서 다른 요소 순열을 동일한 것으로 인식해야합니다. 예를 들어, list(1,c(2,3,4),c(5,6),7)와 list(7,1,c(2,3,4),c(6,5))동일하다.

이 문제가 전체 세트에 대한 배타적 파티션에 대해 논의하고 있기 때문에 list의 요소 (예 : no)에는 반복 이 없습니다list(c(1,2),c(2,1),c(1,2)) .

다른 순열 중 일부 lst를 아래 목록에 나열 했습니다.

lst <- list(list(1,c(2,3,4),c(5,6),7),
            list(c(2,3,4),1,7,c(5,6)),
            list(1,c(2,3,4),7,c(6,5)),
            list(7,1,c(3,2,4),c(5,6)))

내가하고 싶은 것은 모든 순열이 동일한 지 확인하는 것입니다. 그렇다면 우리는 결과를 얻습니다 TRUE.

내가 지금까지했던 것은 각 파티션 내의 요소를 정렬하고, 사용 setdiff()과 interset()그리고 union()그것을 판단하는 (아래 내 코드 참조)

s <- Map(function(v) Map(sort,v),lst)
equivalent <- length(setdiff(Reduce(union,s),Reduce(intersect,s),))==0

그러나 파티션 크기가 커질 때 마다이 방법이 느릴 것이라고 생각합니다. 더 빠른 접근 방법이 있습니까? 미리 감사드립니다!

  • 일부 테스트 사례 (소형 데이터)
# should return `TRUE`
lst1 <- list(list(1,c(2,3,4),c(5,6)),
            list(c(2,3,4),1,c(5,6)),
            list(1,c(2,3,4),c(6,5)))

# should return `TRUE`
lst2 <- list(list(1:2, 3:4), list(3:4, 1:2))

# should return `FALSE`
lst3 <- list(list(1,c(2,3,4),c(5,6)), list(c(2,3,4),1,c(5,6)), list(1,c(2,3,5),c(6,4)))
r  algorithm  list  performance 
— ThomasIsCoding
소스
1
여러 Map통화를 피할 수있을 것 같습니다
— akrun
1
나는 동일한 크기의 파티션으로 질문 하나에 몇 가지 더 테스트 케이스를 추가 제안 것입니다 lst_equal = list(list(1:2, 3:4), list(3:4, 1:2))결과가 있어야 할 곳에 하나와 FALSE아마,lst_false <- list(list(1,c(2,3,4),c(5,6)), list(c(2,3,4),1,c(5,6)), list(1,c(2,3,5),c(6,4)))
— 그레고르 토마스에게
3
예상되는 결과가있는 곳을 포함하여 여러 개의 작은 예제를 사용하는 것이 좋습니다 FALSE. 이렇게하면 모든 테스트 사례가 아닌 일부 테스트 사례에서 답이 작동하면 이유를 쉽게 진단 할 수 있습니다. 예가 하나만 있으면 테스트 결과에서 뉘앙스가 사라집니다. 이미 작업 한 사람들의 기존 예제를 변경하지 않고 새 예제를 추가하는 것도 좋습니다.
— Gregor Thomas
1
나는 당신의 설명은 내가 당신이 생각하게하는 주석을 추가 할 것으로 예상 결과는 당신이 단지 그것을 확인하고, TRUE로. 그렇지 않은 경우 (예를 들어, 상당한 수의 FALSE를 얻는다고 생각되는 경우), 특히 길이 lst가 길면 다른 방법으로 효율성을 얻을 수 있습니다. 예를 들어, 첫 번째 체크 length(unique(lengths(lst))) == 1매우 빠르게 반환 FALSE내부 목록의 모든 요소의 잘못된 번호가있는 경우 ....
— 그레고르 토마스
1
그 통과하면, 당신은을 통해 한 번에 하나 개의 항목을 이동 할 수 있습니다 할 수 lst비교 lst[[i]]에 lst[[1]], 당신은 오히려 모든 비교를하는 것보다, 불일치를 발견하면 그런 식으로 당신은 즉시 중지 할 수 있습니다. 경우 lst길이와 FALSE의 공통점이며, 이것은 아마도 그렇지 않으면 가치가 큰 효율이 증가 될 수 있지만 수 있습니다.
— Gregor Thomas

답변:

6

rcpp 기능을 갖춘 솔루션이 없으면 fast 에 대한 게시물 R과 변형이 완료되지 않습니다 .

효율성을 극대화하려면 올바른 데이터 구조를 선택하는 것이 무엇보다 중요합니다. 우리의 데이터 구조는 고유 한 값을 저장하고 빠른 삽입 / 액세스가 필요합니다. 이것이 바로 std :: unorder_set이 구현하는 것입니다. 우리는 각각 vector의 정렬되지 않은 각각 을 고유하게 식별 할 수있는 방법을 결정하기 만하면 integers됩니다.

산술 의 기본 정리를 입력

FTA는 모든 숫자 를 소수의 곱 으로 고유하게 ( 요소 의 순서 까지) 나타낼 수 있다고 명시하고 있습니다 .

다음은 두 벡터가 순서에 해당하는 경우 FTA를 사용하여 빠르게 해독 할 수있는 방법을 보여주는 예입니다 ( P아래 NB 는 소수 목록입니다 ... (2, 3, 5, 7, 11, etc.):

                   Maps to                    Maps to              product
vec1 = (1, 2, 7)    -->>    P[1], P[2], P[7]   --->>   2,  3, 17     -->>   102
vec2 = (7, 3, 1)    -->>    P[7], P[3], P[1]   --->>  17,  5,  2     -->>   170
vec3 = (2, 7, 1)    -->>    P[2], P[7], P[1]   --->>   3, 17,  2     -->>   102

이로부터 우리는 볼 vec1과 vec3반면 올바르게, 같은 번호에 매핑 vec2다른 값으로 매핑됩니다.

실제 벡터는 1000보다 작은 정수를 100 개까지 포함 할 수 있으므로 FTA를 적용하면 매우 큰 숫자가 생성됩니다. 우리는 곱의 로그 규칙을 이용하여이 문제를 해결할 수 있습니다.

로그 b (xy) = 로그 b (x) + 로그 b (y)

이것으로 우리는 더 많은 수의 예제를 처리 할 수 ​​있습니다 (이것은 매우 큰 예제에서 악화되기 시작합니다).

먼저 간단한 소수 생성기가 필요합니다 (NB 실제로 각 소수의 로그를 생성하고 있습니다).

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::plugins(cpp11)]]

void getNPrimes(std::vector<double> &logPrimes) {

    const int n = logPrimes.size();
    const int limit = static_cast<int>(2.0 * static_cast<double>(n) * std::log(n));
    std::vector<bool> sieve(limit + 1, true);

    int lastP = 3;
    const int fsqr = std::sqrt(static_cast<double>(limit));

    while (lastP <= fsqr) {
        for (int j = lastP * lastP; j <= limit; j += 2 * lastP)
            sieve[j] = false;

        int ind = 2;

        for (int k = lastP + 2; !sieve[k]; k += 2)
            ind += 2;

        lastP += ind;
    }

    logPrimes[0] = std::log(2.0);

    for (int i = 3, j = 1; i <= limit && j < n; i += 2)
        if (sieve[i])
            logPrimes[j++] = std::log(static_cast<double>(i));
}

그리고 주요 구현은 다음과 같습니다.

// [[Rcpp::export]]
bool f_Rcpp_Hash(List x) {

    List tempLst = x[0];
    const int n = tempLst.length();
    int myMax = 0;

    // Find the max so we know how many primes to generate
    for (int i = 0; i < n; ++i) {
        IntegerVector v = tempLst[i];
        const int tempMax = *std::max_element(v.cbegin(), v.cend());

        if (tempMax > myMax)
            myMax = tempMax;
    }

    std::vector<double> logPrimes(myMax + 1, 0.0);
    getNPrimes(logPrimes);
    double sumMax = 0.0;

    for (int i = 0; i < n; ++i) {
        IntegerVector v = tempLst[i];
        double mySum = 0.0;

        for (auto j: v)
            mySum += logPrimes[j];

        if (mySum > sumMax)
            sumMax = mySum;
    }

    // Since all of the sums will be double values and we want to
    // ensure that they are compared with scrutiny, we multiply
    // each sum by a very large integer to bring the decimals to
    // the right of the zero and then convert them to an integer.
    // E.g. Using the example above v1 = (1, 2, 7) & v2 = (7, 3, 1)
    //              
    //    sum of log of primes for v1 = log(2) + log(3) + log(17)
    //                               ~= 4.62497281328427
    //
    //    sum of log of primes for v2 = log(17) + log(5) + log(2)
    //                               ~= 5.13579843705026
    //    
    //    multiplier = floor(.Machine$integer.max / 5.13579843705026)
    //    [1] 418140173
    //    
    // Now, we multiply each sum and convert to an integer
    //    
    //    as.integer(4.62497281328427 * 418140173)
    //    [1] 1933886932    <<--   This is the key for v1
    //
    //    as.integer(5.13579843705026 * 418140173)
    //    [1] 2147483646    <<--   This is the key for v2

    const uint64_t multiplier = std::numeric_limits<int>::max() / sumMax;
    std::unordered_set<uint64_t> canon;
    canon.reserve(n);

    for (int i = 0; i < n; ++i) {
        IntegerVector v = tempLst[i];
        double mySum = 0.0;

        for (auto j: v)
            mySum += logPrimes[j];

        canon.insert(static_cast<uint64_t>(multiplier * mySum));
    }

    const auto myEnd = canon.end();

    for (auto it = x.begin() + 1; it != x.end(); ++it) {
        List tempLst = *it;

        if (tempLst.length() != n)
            return false;

        for (int j = 0; j < n; ++j) {
            IntegerVector v = tempLst[j];
            double mySum = 0.0;

            for (auto k: v)
                mySum += logPrimes[k];

            const uint64_t key = static_cast<uint64_t>(multiplier * mySum);

            if (canon.find(key) == myEnd)
                return false;
        }
    }

    return true;
}

lst1, lst2, lst3, & lst (the large one)@GKi 가 제공 한 결과는 다음과 같습니다 .

f_Rcpp_Hash(lst)
[1] TRUE

f_Rcpp_Hash(lst1)
[1] TRUE

f_Rcpp_Hash(lst2)
[1] FALSE

f_Rcpp_Hash(lst3)
[1] FALSE

다음은 units매개 변수가로 설정된 벤치 마크입니다 relative.

microbenchmark(check = 'equal', times = 10
               , unit = "relative"
               , f_ThomsIsCoding(lst3)
               , f_chinsoon12(lst3)
               , f_GKi_6a(lst3)
               , f_GKi_6b(lst3)
               , f_Rcpp_Hash(lst3))
Unit: relative
                 expr       min        lq      mean    median        uq       max neval
f_ThomsIsCoding(lst3) 84.882393 63.541468 55.741646 57.894564 56.732118 33.142979    10
   f_chinsoon12(lst3) 31.984571 24.320220 22.148787 22.393368 23.599284 15.211029    10
       f_GKi_6a(lst3)  7.207269  5.978577  5.431342  5.761809  5.852944  3.439283    10
       f_GKi_6b(lst3)  7.399280  5.751190  6.350720  5.484894  5.893290  8.035091    10
    f_Rcpp_Hash(lst3)  1.000000  1.000000  1.000000  1.000000  1.000000  1.000000    10


microbenchmark(check = 'equal', times = 10
               , unit = "relative"
               , f_ThomsIsCoding(lst)
               , f_chinsoon12(lst)
               , f_GKi_6a(lst)
               , f_GKi_6b(lst)
               , f_Rcpp_Hash(lst))
Unit: relative
                expr        min         lq       mean     median        uq       max neval
f_ThomsIsCoding(lst) 199.776328 202.318938 142.909407 209.422530 91.753335 85.090838    10
   f_chinsoon12(lst)   9.542780   8.983248   6.755171   9.766027  4.903246  3.834358    10
       f_GKi_6a(lst)   3.169508   3.158366   2.555443   3.731292  1.902140  1.649982    10
       f_GKi_6b(lst)   2.992992   2.943981   2.019393   3.046393  1.315166  1.069585    10
    f_Rcpp_Hash(lst)   1.000000   1.000000   1.000000   1.000000  1.000000  1.000000    10

더 큰 예제에서 가장 빠른 솔루션보다 약 3 배 빠릅니다 .

이것은 무엇을 의미 하는가?

나 에게이 결과는 base R@GKi, @ chinsoon12, @Gregor, @ThomasIsCoding 등으로 표시되는 아름다움과 효율성에 볼륨을줍니다 . 우리는 C++적당한 속도를 얻기 위해 약 100 줄의 매우 구체적인 내용 을 썼습니다 . 공평하게 말하면, base R솔루션은 대부분 컴파일 된 코드를 호출하고 위에서했던 것처럼 해시 테이블을 사용하게됩니다.

— 조셉 우드
소스
1
@ThomasIsCoding, 나는 당신이 내 대답을 선택하게 된 것을 영광으로 생각하지만 다른 대답이 더 낫다고 생각합니다.
— Joseph Wood
1
당신의 공헌에 대단히 감사합니다! 당신의 일은 훌륭합니다!
— ThomasIsCoding
5

정렬 후 duplicated및 을 사용할 수 있습니다 all.

s <- lapply(lst, function(x) lapply(x, sort)) #Sort vectors
s <- lapply(s, function(x) x[order(vapply(x, "[", 1, 1))]) #Sort lists
all(duplicated(s)[-1]) #Test if there are all identical
#length(unique(s)) == 1 #Alternative way to test if all are identical

대안 : 하나의 루프에서 정렬

s <- lapply(lst, function(x) {
  tt <- lapply(x, sort)
  tt[order(vapply(tt, "[", 1, 1))]
})
all(duplicated(s)[-1])

대안 : 루프 중에 정렬하고 조기 종료 허용

s <- lapply(lst[[1]], sort)
s <- s[order(vapply(s, "[", 1, 1))]
tt  <- TRUE
for(i in seq(lst)[-1]) {
  x <- lapply(lst[[i]], sort)
  x <- x[order(vapply(x, "[", 1, 1))]
  if(!identical(s, x)) {
    tt  <- FALSE
    break;
  }
}
tt

또는 사용 setequal

s <- lapply(lst[[1]], sort)
tt  <- TRUE
for(i in seq(lst)[-1]) {
  x <- lapply(lst[[i]], sort)
  if(!setequal(s, x)) {
    tt  <- FALSE
    break;
  }
}
tt

또는 @ chinsoon12 의 아이디어를 약간 개선 하여 목록을 벡터와 교환하십시오!

s <- lst[[1]][order(vapply(lst[[1]], min, 1))]
s <- rep(seq_along(s), lengths(s))[order(unlist(s))]
tt <- TRUE
for(i in seq(lst)[-1]) {
  x <- lst[[i]][order(vapply(lst[[i]], min, 1))]
  x <- rep(seq_along(x), lengths(x))[order(unlist(x))]
  if(!identical(s, x)) {tt <- FALSE; break;}
}
tt

또는 두 번째를 피하십시오 order

s <- lst[[1]][order(vapply(lst[[1]], min, 1))]
s <- rep(seq_along(s), lengths(s))[order(unlist(s))]
y <- s
tt <- TRUE
for(i in seq(lst)[-1]) {
  x <- lst[[i]][order(vapply(lst[[i]], min, 1))]
  y <- y[0]
  y[unlist(x)] <- rep(seq_along(x), lengths(x))
  if(!identical(s, y)) {tt <- FALSE; break;}
}
tt

또는 (또는 ) order와 교환matchfmatch

x <- lst[[1]]
s <- "[<-"(integer(),unlist(x),rep(seq_along(x), lengths(x)))
s <- match(s, unique(s))
tt <- TRUE
for(i in seq(lst)[-1]) {
  x <- lst[[i]]
  y <- "[<-"(integer(),unlist(x),rep(seq_along(x), lengths(x)))
  y <- match(y, unique(y))
  if(!identical(s, y)) {tt <- FALSE; break;}
}
tt

또는 조기 종료가 없습니다.

s <- lapply(lst, function(x) {
  y <- "[<-"(integer(),unlist(x),rep(seq_along(x), lengths(x)))
  match(y, unique(y))
})
all(duplicated(s)[-1])

또는 C ++로 작성

sourceCpp(code = "#include <Rcpp.h>
#include <vector>
using namespace Rcpp;
// [[Rcpp::plugins(cpp11)]]
// [[Rcpp::export]]
bool f_GKi_6_Rcpp(const List &x) {
  const List &x0 = x[0];
  const unsigned int n = x0.length();
  unsigned int nn = 0;
  for (List const &i : x0) {nn += i.length();}
  std::vector<int> s(nn);
  for (unsigned int i=0; i<n; ++i) {
    const IntegerVector &v = x0[i];
    for (int const &j : v) {
      if(j > nn) return false;
      s[j-1] = i;
    }
  }
  {
    std::vector<int> lup(n, -1);
    int j = 0;
    for(int &i : s) {
      if(lup[i] < 0) {lup[i] = j++;}
      i = lup[i];
    }
  }
  for (List const &i : x) {
    if(i.length() != n) return false;
    std::vector<int> sx(nn);
    for(unsigned int j=0; j<n; ++j) {
      const IntegerVector &v = i[j];
      for (int const &k : v) {
        if(k > nn) return false;
        sx[k-1] = j;
      }
    }
    {
      std::vector<int> lup(n, -1);
      int j = 0;
      for(int &i : sx) {
        int &lupp = lup[i];
        if(lupp == -1) {lupp = j; i = j++;
        } else {i = lupp;}
      }
    }
    if(s!=sx) return false;
  }
  return true;
}
")

답변을 개선 할 수있는 힌트를 주신 @Gregor에게 감사드립니다!

— GKi
소스
나는 같은 크기의 파티션을 가질 때 작동한다고 생각하지 않지만 크기가 다른 파티션을 가질 때 내 것보다 빠릅니다. 예를 들어 다음과 lst <- list(list(1,c(2,3,4),c(5,6),7), list(c(2,3,4),1,7,c(5,6)), list(1,c(2,3,4),7,c(6,5)), list(7,1,c(3,2,4),c(5,6)))같이 판단됩니다.FALSE
— ThomasIsCoding
1
@Gregor 팁을 정렬 해 주셔서 감사합니다 min!
— GKi
좋아 보인다! 더 빠른 솔루션이 있는지 조금 더 기다릴 것입니다.
— ThomasIsCoding
더 빠른 솔루션을 찾기 위해 데이터 세트의 실제 크기는 얼마입니까?
— chinsoon12
효율성을 확인하기 위해 성능 벤치 마크를 추가했습니다 (새로 편집 한 게시물 참조). 귀하의 솔루션은 특히 2 단계 솔루션보다 빠릅니다. 더 큰 개선 사항이있는 솔루션이 나타날 때까지 기다리고 싶습니다. 그렇지 않으면 귀하의 솔루션이 가장 적합합니다. 다시 감사합니다!
— ThomasIsCoding
4

공연:

library(microbenchmark)

microbenchmark(check = 'equal', times=10
  , f_ThomsIsCoding(lst1)
  , f_chinsoon12(lst1)
  , f_GKi_6a(lst1)
  , f_GKi_6b(lst1)
  , f_GKi_6_Rcpp(lst1)
  , f_Rcpp_Hash(lst1))
#Unit: microseconds
#                  expr        min         lq        mean     median         uq        max neval
# f_ThomsIsCoding(lst1) 161187.790 162453.520 167107.5739 167899.471 169441.028 174746.156    10
#    f_chinsoon12(lst1)  64380.792  64938.528  66983.9449  67357.924  68487.438  69201.032    10
#        f_GKi_6a(lst1)   8833.595   9201.744  10377.5844   9407.864  12145.926  14662.022    10
#        f_GKi_6b(lst1)   8815.592   8913.950   9877.4948   9112.924  10941.261  12553.845    10
#    f_GKi_6_Rcpp(lst1)    394.754    426.489    539.1494    439.644    451.375   1327.885    10
#     f_Rcpp_Hash(lst1)    327.665    374.409    499.4080    398.101    495.034   1198.674    10

microbenchmark(check = 'equal', times=10
  , f_ThomsIsCoding(lst2)
  , f_chinsoon12(lst2)
  , f_GKi_6a(lst2)
  , f_GKi_6b(lst2)
  , f_GKi_6_Rcpp(lst2)
  , f_Rcpp_Hash(lst2))
#Unit: microseconds
#                  expr       min        lq        mean      median         uq        max neval
# f_ThomsIsCoding(lst2) 93808.603 99663.651 103358.2039 104676.1600 107124.879 107485.696    10
#    f_chinsoon12(lst2)   131.320   147.192    192.5354    188.1935    205.053    337.062    10
#        f_GKi_6a(lst2)  8630.970  9554.279  10681.9510   9753.2670  11970.377  13489.243    10
#        f_GKi_6b(lst2)    39.736    47.916     61.3929     52.7755     63.026    110.808    10
#    f_GKi_6_Rcpp(lst2)    43.017    51.022     72.8736     76.3465     86.527    116.060    10
#     f_Rcpp_Hash(lst2)     3.667     4.237     20.5887     16.3000     18.031     96.728    10

microbenchmark(check = 'equal', times=10
  , f_ThomsIsCoding(lst3)
  , f_chinsoon12(lst3)
  , f_GKi_6a(lst3)
  , f_GKi_6b(lst3)
  , f_GKi_6_Rcpp(lst3)
  , f_Rcpp_Hash(lst3))
#Unit: microseconds
#                  expr        min         lq        mean      median         uq        max neval
# f_ThomsIsCoding(lst3) 157660.501 166914.782 167067.2512 167204.9065 168055.941 177153.694    10
#    f_chinsoon12(lst3)    139.157    181.019    183.9257    188.0950    198.249    211.860    10
#        f_GKi_6a(lst3)   9484.496   9617.471  10709.3950  10056.1865  11812.037  12830.560    10
#        f_GKi_6b(lst3)     33.583     36.338     47.1577     42.6540     63.469     66.640    10
#    f_GKi_6_Rcpp(lst3)     60.010     60.455     89.4963     94.7220    104.271    121.431    10
#     f_Rcpp_Hash(lst3)      4.404      5.518      9.9811      6.5115     17.396     20.090    10

microbenchmark(check = 'equal', times=10
  , f_ThomsIsCoding(lst4)
  , f_chinsoon12(lst4)
  , f_GKi_6a(lst4)
  , f_GKi_6b(lst4)
  , f_GKi_6_Rcpp(lst4)
  , f_Rcpp_Hash(lst4))
#Unit: milliseconds
#                  expr         min          lq       mean      median          uq        max neval
# f_ThomsIsCoding(lst4) 1874.129146 1937.643431 2012.99077 2002.460746 2134.072981 2187.46886    10
#    f_chinsoon12(lst4)   69.949917   74.393779   80.25362   76.595763   87.116571  100.57917    10
#        f_GKi_6a(lst4)   23.259178   23.328548   27.62690   28.856612   30.675259   32.57509    10
#        f_GKi_6b(lst4)   22.200969   22.326122   24.20769   23.023687   23.619360   31.74266    10
#    f_GKi_6_Rcpp(lst4)    8.062451    8.228526   10.30559    8.363314   13.425531   13.80677    10
#     f_Rcpp_Hash(lst4)    6.551370    6.586025    7.22958    6.724232    6.809745   11.97631    10

라이브러리 :

system.time(install.packages("Rcpp"))
#       User      System verstrichen 
#     27.576       1.147      29.396 

system.time(library(Rcpp))
#       User      System verstrichen 
#      0.070       0.000       0.071

기능 :

system.time({f_ThomsIsCoding <- function(lst) {
  s <- Map(function(v) Map(sort,v),lst)
  length(setdiff(Reduce(union,s),Reduce(intersect,s)))==0
}})
#       User      System verstrichen 
#          0           0           0 

#like GKi's solution to stop early when diff is detected
system.time({f_chinsoon12  <- function(lst) {
    x <- lst[[1L]]
    y <- x[order(lengths(x), sapply(x, min))]
    a <- rep(seq_along(y), lengths(y))[order(unlist(y))]
    for(x in lst[-1L]) {
        y <- x[order(lengths(x), sapply(x, min))]
        a2 <- rep(seq_along(y), lengths(y))[order(unlist(y))]
        if(!identical(a, a2)) {
            return(FALSE)
        }
    }
    TRUE
}})
#       User      System verstrichen 
#          0           0           0 

system.time({f_GKi_6a <- function(lst) {
  all(duplicated(lapply(lst, function(x) {
    y <- "[<-"(integer(),unlist(x),rep(seq_along(x), lengths(x)))
    match(y, unique(y))
  }))[-1])
}})
#      User      System verstrichen 
#          0           0           0 

system.time({f_GKi_6b <- function(lst) {
  x <- lst[[1]]
  s <- "[<-"(integer(),unlist(x),rep(seq_along(x), lengths(x)))
  s <- match(s, unique(s))
  for(i in seq(lst)[-1]) {
    x <- lst[[i]]
    y <- "[<-"(integer(),unlist(x),rep(seq_along(x), lengths(x)))
    y <- match(y, unique(y))
    if(!identical(s, y)) return(FALSE)
  }
  TRUE
}})
#       User      System verstrichen 
#          0           0           0 

system.time({sourceCpp(code = "#include <Rcpp.h>
#include <vector>
using namespace Rcpp;
// [[Rcpp::plugins(cpp11)]]
// [[Rcpp::export]]
bool f_GKi_6_Rcpp(const List &x) {
  const List &x0 = x[0];
  const unsigned int n = x0.length();
  unsigned int nn = 0;
  for (List const &i : x0) {nn += i.length();}
  std::vector<int> s(nn);
  for (unsigned int i=0; i<n; ++i) {
    const IntegerVector &v = x0[i];
    for (int const &j : v) {
      if(j > nn) return false;
      s[j-1] = i;
    }
  }
  {
    std::vector<int> lup(n, -1);
    int j = 0;
    for(int &i : s) {
      if(lup[i] < 0) {lup[i] = j++;}
      i = lup[i];
    }
  }
  for (List const &i : x) {
    if(i.length() != n) return false;
    std::vector<int> sx(nn);
    for(unsigned int j=0; j<n; ++j) {
      const IntegerVector &v = i[j];
      for (int const &k : v) {
        if(k > nn) return false;
        sx[k-1] = j;
      }
    }
    {
      std::vector<int> lup(n, -1);
      int j = 0;
      for(int &i : sx) {
        int &lupp = lup[i];
        if(lupp == -1) {lupp = j; i = j++;
        } else {i = lupp;}
      }
    }
    if(s!=sx) return false;
  }
  return true;
}
")})
#       User      System verstrichen 
#      3.265       0.217       3.481 

system.time({sourceCpp(code = "#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::plugins(cpp11)]]

void getNPrimes(std::vector<double> &logPrimes) {
    const int n = logPrimes.size();
    const int limit = static_cast<int>(2.0 * static_cast<double>(n) * std::log(n));
    std::vector<bool> sieve(limit + 1, true);
    int lastP = 3;
    const int fsqr = std::sqrt(static_cast<double>(limit));

    while (lastP <= fsqr) {
        for (int j = lastP * lastP; j <= limit; j += 2 * lastP)
            sieve[j] = false;
        int ind = 2;
        for (int k = lastP + 2; !sieve[k]; k += 2)
            ind += 2;
        lastP += ind;
    }
    logPrimes[0] = std::log(2.0);
    for (int i = 3, j = 1; i <= limit && j < n; i += 2)
        if (sieve[i])
            logPrimes[j++] = std::log(static_cast<double>(i));
}

// [[Rcpp::export]]
bool f_Rcpp_Hash(List x) {
    List tempLst = x[0];
    const int n = tempLst.length();
    int myMax = 0;
    // Find the max so we know how many primes to generate
    for (int i = 0; i < n; ++i) {
        IntegerVector v = tempLst[i];
        const int tempMax = *std::max_element(v.cbegin(), v.cend());
        if (tempMax > myMax)
            myMax = tempMax;
    }
    std::vector<double> logPrimes(myMax + 1, 0.0);
    getNPrimes(logPrimes);
    double sumMax = 0.0;
    for (int i = 0; i < n; ++i) {
        IntegerVector v = tempLst[i];
        double mySum = 0.0;
        for (auto j: v)
            mySum += logPrimes[j];
        if (mySum > sumMax)
            sumMax = mySum;
    }
    const uint64_t multiplier = std::numeric_limits<int>::max() / sumMax;
    std::unordered_set<uint64_t> canon;
    canon.reserve(n);
    for (int i = 0; i < n; ++i) {
        IntegerVector v = tempLst[i];
        double mySum = 0.0;
        for (auto j: v)
            mySum += logPrimes[j];
        canon.insert(static_cast<uint64_t>(multiplier * mySum));
    }
    const auto myEnd = canon.end();
    for (auto it = x.begin() + 1; it != x.end(); ++it) {
        List tempLst = *it;
        if (tempLst.length() != n)
            return false;
        for (int j = 0; j < n; ++j) {
            IntegerVector v = tempLst[j];
            double mySum = 0.0;
            for (auto k: v)
                mySum += logPrimes[k];
            const uint64_t key = static_cast<uint64_t>(multiplier * mySum);
            if (canon.find(key) == myEnd)
                return false;
        }
    }
    return true;
}
")})
#       User      System verstrichen 
#      3.507       0.155       3.662

데이터:

lst1 <- list(list(1,c(2,3,4),c(5,6)) #TRUE
           , list(c(2,3,4),1,c(5,6))
           , list(1,c(2,3,4),c(6,5)))
lst2 <- list(list(c(2,3,4),c(1,5,6)) #FALSE
           , list(c(2,3,6),c(1,5,4))
           , list(c(2,3,4),c(1,5,6)))
lst3 <- list(list(1,c(2,3,4),c(5,6)) #FALSE
           , list(c(2,3,4),1,c(5,6))
           , list(1,c(2,3,5),c(6,4)))
set.seed(7)
N  <- 1e3
lst1 <- lst1[sample(seq(lst1), N, TRUE)]
lst2 <- lst2[sample(seq(lst2), N, TRUE)]
lst3 <- lst3[sample(seq(lst3), N, TRUE)]
N <- 1000
M <- 500
l <- unname(split(1:N,findInterval(1:N,sort(sample(1:N,N/10)),left.open = T)))
lst4 <- lapply(lapply(1:M, 
                     function(k) lapply(l, 
                                        function(v) v[sample(seq_along(v),length(v))])), function(x) x[sample(seq_along(x),length(x))])
— GKi
소스
대단히 감사합니다! 방금 코드에 오타가 있음을 알았습니다. length(setdiff(Reduce(union,s),Reduce(intersect,s)))==0 실수로 미안합니다 ....
— ThomasIsCoding
@ThomasIsCoding 답변이 업데이트되었습니다. 그러나 나는 Wiki로 만들었으므로 모든 사람들이 새로운 솔루션을 업데이트하고 포함하고 이것을 반복하지 않는 것이 좋습니다.
— GKi
당신의 노력에 감사드립니다! 나는 지금 내 솔루션이 수정 후 당신과 동일한 결과를 제공하지만 당신보다 느리다고 생각합니다. :)
— ThomasIsCoding
대박! 성능을 크게 향상시킵니다! 나는 당신의 해결책을 받아들입니다!
— ThomasIsCoding
@ chinsoon12 나에게 상기시켜 주셔서 대단히 감사합니다! 이제 나는 그것을 받아들이 기 위해 다른 것으로 변경했습니다
— ThomasIsCoding
3

행운을 빕니다

f <- function(lst) {
    s <- lapply(lst, function(x) {
        y <- x[order(lengths(x), sapply(x, min))]
        rep(seq_along(y), lengths(y))[order(unlist(y))]
    })
    length(unique(s))==1L
}

테스트 사례 :

# should return `TRUE`
lst1 <- list(list(1,c(2,3,4),c(5,6)),
    list(c(2,3,4),1,c(5,6)),
    list(1,c(2,3,4),c(6,5)))

# should return `TRUE`
lst2 <- list(list(1:2, 3:4), list(3:4, 1:2))

# should return `FALSE`
lst3 <- list(list(1,c(2,3,4),c(5,6)), list(c(2,3,4),1,c(5,6)), list(1,c(2,3,5),c(6,4)))

# should return `FALSE`
lst4 <- list(list(c(2,3,4),c(1,5,6)), list(c(2,3,6),c(1,5,4)), list(c(2,3,4),c(1,5,6)))

lst5 <- list(list(1,c(2,3,4),c(5,6)) #TRUE
    , list(c(2,3,4),1,c(5,6))
    , list(1,c(2,3,4),c(6,5)))
lst6 <- list(list(c(2,3,4),c(1,5,6)) #FALSE
    , list(c(2,3,6),c(1,5,4))
    , list(c(2,3,4),c(1,5,6)))
lst7 <- list(list(1,c(2,3,4),c(5,6)) #FALSE
    , list(c(2,3,4),1,c(5,6))
    , list(1,c(2,3,5),c(6,4)))

체크 무늬:

f(lst1)
#[1] TRUE
f(lst2)
#[1] TRUE
f(lst3)
#[1] FALSE
f(lst4)
#[1] FALSE
f(lst5)
#[1] TRUE
f(lst6)
#[1] FALSE
f(lst7)
#[1] FALSE

타이밍 코드 :

library(microbenchmark)
set.seed(0L)
N <- 1000
M <- 100
l <- unname(split(1:N,findInterval(1:N,sort(sample(1:N,N/10)),left.open = T)))
lst <- lapply(lapply(1:M,
    function(k) lapply(l,
        function(v) v[sample(seq_along(v),length(v))])), function(x) x[sample(seq_along(x),length(x))])

f_ThomsIsCoding <- function(lst) {
    s <- Map(function(v) Map(sort,v),lst)
    length(setdiff(Reduce(union,s),Reduce(intersect,s)))==0
}

f_GKi_1 <- function(lst) {
    all(duplicated(lapply(lst, function(x) lapply(x, sort)[order(unlist(lapply(x, min)))]))[-1])
}

f_GKi_2 <- function(lst) {
    s <- lapply(lst, function(x) lapply(x, sort))
    all(duplicated(lapply(s, function(x) x[order(unlist(lapply(x, "[", 1)))]))[-1])
}


f <- function(lst) {
    s <- lapply(lst, function(x) {
        y <- x[order(lengths(x), sapply(x, min))]
        rep(seq_along(y), lengths(y))[order(unlist(y))]
    })
    length(unique(s))==1L
}

microbenchmark(times=3L,
    f_ThomsIsCoding(lst),
    f_GKi_1(lst),
    f_GKi_2(lst),
    f(lst)
)

타이밍 :

Unit: milliseconds
                 expr       min        lq      mean    median        uq      max neval
 f_ThomsIsCoding(lst) 333.77313 334.61662 348.37474 335.46010 355.67555 375.8910     3
         f_GKi_1(lst) 324.12827 324.66580 326.33016 325.20332 327.43111 329.6589     3
         f_GKi_2(lst) 315.73533 316.05770 333.35910 316.38007 342.17099 367.9619     3
               f(lst)  12.42986  14.08256  15.74231  15.73526  17.39853  19.0618     3
— 친순 12
소스
그렇습니다, 이번에는 잘 작동합니다
— ThomasIsCoding
당사 사이트를 사용함과 동시에 당사의 쿠키 정책과 개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.