Вектор расщепления такой, что средства двух групп почти равны

Question

У меня есть фрейм данных df с 2 переменными A и B. Я хотел бы разбить A на группы 1 и 2 так, чтобы mean(df$B[df$group==1]) было как можно ближе к mean(df$B[df$group==2])

Или просто выразить это иначе, я хотел бы найти точку отсечения (cutp) в df$A, которая бы минимизировала abs(mean(df$B[df$A<cutp])-mean(df$B[df$A>=cutp]))

Есть идеи?

Answer 1

Если вы хотите найти пороговое значение для переменной A, чтобы разбить данные на две группы, чтобы средние значения B в этих двух группах были одинаковыми, вы можете вычислить эти значения для всех возможных точек нарезки и проверить, когдарасстояние между этими средствами минимально.

# Sample data
n <- 10
d <- data.frame(
  A = rnorm(n),
  B = rnorm(n)
)

# The quantity to minimize
# (You can use a loop instead of apply.)
d$differences <- apply(
  d, 1, 
  # Compute the difference of the means for each value of A
  function (u) { 
    i <- d$A <= u[1]; 
    abs( mean( d$B[which(i)]) - mean(d$B[which(!i)] ) )
  } 
)
# The mean of an empty vector is NaN: discard those values
d$differences[ ! is.finite( d$differences ) ] <- Inf
# Take the minimum
threshold <- d$A[ which.min( d$differences ) ]
# Build the groups
d$group <- ifelse( d$A <= threshold, "group 1", "group 2" )

Answer 2

Я все еще не уверен, как столбец А влияет на это. Кажется, вы хотите создать новый столбец, который имеет два уровня, которые создают ~ = средние значения для столбца B. Столбец A, очевидно, связан с созданным новым столбцом, но напрямую не учитывает необходимые вычисления. Я что-то пропустил?

В любом случае, вот начало (обратите внимание, что это можно сделать гораздо более надежным, но доказательство концепции должно работать). Определите допустимое отклонение, которое вы сочтете приемлемым, а затем настройте цикл while для создания новых групп, пока не будет выполнено условие, т. Е.

FUN <- function(tol){
  df$groups <- sample(1:2, nrow(df), TRUE)

  while(abs(mean(df$B[df$groups == 1]) - mean(df$B[df$groups == 2])) > tol) {
    df$groups <- sample(1:2, nrow(df), TRUE)
  }
  return(df)
}

set.seed(101)
df <- data.frame(A=runif(20),B=runif(20))

#Test it. Means should be less than .02 different and have roughly equivalent sample sizes.
set.seed(101)
out <- FUN(.02)
library(plyr)
> ddply(out, "groups", summarize, n = length(B), mean = mean(B))
  groups  n      mean
1      1 11 0.5229024
2      2  9 0.5037279

Я должен заметить, что вы можете создать убегающую функцию, если вы установите tol super low, поэтому не вините меня, если ваш компьютер выходит из строя.