Problem 103, 105, 106

R Project Euler

大きさ n の集合 A の要素の和を S(A) で表す. 空でなく共通要素を持たないいかなる 2 つの部分集合 B と C に対しても以下の性質が真であれば, A を特殊和集合と呼ぼう.

  • i. S(B)≠S(C); つまり, 部分集合の和が等しくてはならない.
  • ii. B が C より多くの要素を含んでいればこのとき S(B) > S(C) となる.

Problem 103はn = 7の集合についてS(A)が最小となるような集合を求めろという問題．
Problem 105はテキストファイルに記された100個の集合(nは7から12)のうち特殊和集合を探せという問題．
Problem 106はn = 12かつiiの条件を満たしているとして，iの条件を調べるために検証する必要がある部分集合の対はいくつあるかという問題(例えばn = 4なら比較は1つでいい)．
最初力技でといて無茶苦茶時間がかかったけどProblem 105は10秒，106は1ms未満まで短縮できた．103はよく分からないのでもう諦める．105と106は似てるけど103は同じアプローチじゃ駄目なのだと思う．
変数名や関数名付けるセンスなさすぎて死にそう．

## 大きさnの集合の大きさmの部分集合の対全て
subset.pairs <- function(n, m){
  subst <- combn(n, m)
  s.len <- length(subst[1,])
  pairs <- combn(1:s.len, 2)
  return(matrix(subst[,pairs], nrow=2 * m))
}

## 大きさnの集合のうち比較の必要な大きさmの部分集合の対
comp.sub <- function(n, m){
  sub.p <- subset.pairs(n, m)
  s.len <- length(sub.p[1,])
  p.len <- length(sub.p[,1])
  cmp.s <- numeric(0)
  curnt <- 1
  for(i in 1:s.len){
    if(max(table(sub.p[, i])) > 1){
      next
    }
    if(sum(sub.p[1:(p.len/2), i] >  sub.p[(p.len/2+1):p.len, i]) == 0 ||
       sum(sub.p[1:(p.len/2), i] <  sub.p[(p.len/2+1):p.len, i]) == 0){
      next
    }
    cmp.s[curnt:((curnt <- curnt+p.len)-1)] <- sub.p[, i]
  }
  return(matrix(cmp.s, nrow=p.len))
}

## 大きさnの集合のうち大きさn/2の大きさで比較が必要な部分集合の対
comp.sub.h <- function(n){
  if(n %% 2 != 0) return(FALSE)         # 奇数の集合は対象外
  subst <- combn(n, n/2)
  set <- 1:n
  s.len <- length(subst[1,])
  cmp.s <- numeric(0)
  curr <- 1
  for(i in 1:s.len){
    s <- subst[,i]
    if(sum(s > set[-s]) == 0 || sum(s < set[-s]) == 0) next
    cmp.s[curr:((curr <- curr + n)-1)] <- c(s, set[-s])
  }
  cmp.l <- length(cmp.s)
  return(matrix(cmp.s[1:(cmp.l/2)], nrow = n))
}
    

## 第二の条件を満たすか
is.clear.2 <- function(A){
  h <- 2
  t <- 0
  repeat{
    if(h + t + 1 > length(A)) break
    if(sum(A[1:h]) <= sum(A[length(A):(length(A)-t)])) return(FALSE)
    h <- h + 1
    t <- t + 1
  }
  return(TRUE)
}

## 条件を満たすか否かの判定
chk.list <- list(comp.sub.h(4),
                 comp.sub.h(6),
                 comp.sub.h(8),
                 comp.sub.h(10),
                 comp.sub.h(12))
is.special.set <- function(A){
  A <- sort(A)                          # 大きさ順にソート
  if(!is.clear.2(A)) return(FALSE)      # 第2の条件
  if(max(table(A)) > 1) return(FALSE)   # 重複はfalse
  A.len <- length(A)
  if(A.len < 4) return(TRUE)            # ここまでパスした大きさ3以下の集合はTRUE
  chk.n <- 1
  chk <- chk.list[[chk.n]]
  for(i in 4:A.len){
    chk.c.p <- combn(A.len, i)          # チェックすべき対の分配パターン
    for(j in 1:length(chk.c.p[1,])){
      chk.set.1 <- A[chk.c.p[,j]]               # チェックすべき対1段階目の分離
      for(k in 1:length(chk[1,])){
        if(sum(chk.set.1[chk[,k][1:(i/2)]]) ==
           sum(chk.set.1[chk[,k][(i/2+1):i]])){
          return(FALSE)
        }
      }
    }
    if(i %% 2 == 1) chk <- chk.list[[(chk.n <- chk.n + 1)]]
  }
  return(TRUE)
}

## 条件を満たすか否かの判定
is.special.set <- function(A){
  if(length(A) <= 2) return(TRUE)
  if(max(table(A)) > 1) return(FALSE)
  if(!is.clear.2(A)) return(FALSE)
  A.len <- length(A)
  if(A.len < 3) return(TRUE)
  for(s.len in 2:(A.len/2)){
    chk.sets <- comp.sub(A.len, s.len)
    for(i in 1:length(chk.sets[1,])){
      if(sum(A[chk.sets[,i][1:s.len]]) == sum(A[chk.sets[,i][(s.len+1):(2*s.len)]])){
        return(FALSE)
      }
    }
  }
  return(TRUE)
}

## 第二の条件を満たすようになるまで数字を加算
plus <- function(A){
  repeat{
    if(A[1] + A[2] < max(A)){
      A <- A + 1
    }else{
      break
    }
  }
  return(A)
}

## Problem 103
A <- 1:7
chk.sub.2 <- comp.sub(7, 2)
chk.sub.3 <- comp.sub(7, 3)
is.special.set.7 <- function(A){
  if(!is.clear.2(A)) return(FALSE)
  for(i in 1:length(chk.sub.2[1,])){
    if(sum(A[chk.sub.2[,i][1:2]]) == sum(A[chk.sub.2[,i][3:4]])){
      return(FALSE)
    }
  }
  for(i in 1:length(chk.sub.3[1,])){
    if(sum(A[chk.sub.3[,i][1:3]]) == sum(A[chk.sub.3[,i][4:6]])){
      return(FALSE)
    }
  }
}
is.special.set.7(0:6)

msp <- function(n){
  n <- 7
  p <- n
  A <- 20:(19+n)
  A <- plus(A)
  B <- rep(0, n)
  repeat{
    if(is.special.set.7(A + B)) return(A + B)
    if(p == 0){
      if(max(table(B)) == n){
        B[1:(n-1)] <- 0
        B[n] <- B[n] + 1
        p <- n - 1
        next
      }else if((i <- sum(B==B[1])) > 1){
        B[1:(i-1)] <- 0
        B[i] <- B[i] + 1
        p <- i - 1
        next
      }else{
        B[1] <- B[1] + 1
        next
      }
    }
    B[p] <- B[p] + 1
    p <- p - 1
  }
}
msp(7)

## Problem 105
sets <- scan("sets.txt", "character")
ans <- 0
for(i in 1:100){
  if(is.special.set(sort(as.numeric(unlist(strsplit(sets[i], ",")))))){
    ans <- ans + sum(as.numeric(unlist(strsplit(sets[i], ","))))
  }
}
ans

## Problem 106
base.len <- unlist(lapply(chk.list, function(x) length(x[1,])))
sum(c(base.len[1] * choose(12, 4),
      base.len[2] * choose(12, 6),
      base.len[3] * choose(12, 8),
      base.len[4] * choose(12,10),
      base.len[5] * choose(12,12)))