r - 如何在R中计算要删除的最小观察数，以实现两组之间的完全可分离性

问题：用R计算要删除的最小观察数，以实现两组之间的完全分离（Nout）。

例如：

df<-data.frame(c(1,2,3,4,5,6,7,10,4,5.5,6,6.5,8,9,12),c(rep("a",8),rep("b",7)))
colnames(df)<-c("Values","Groups")
df
boxplot(df[,1]~df[,2])
points(df[,1]~df[,2],cex=2)
abline(6.2,0)

See the plot produced with the above code here。

在这种情况下，删除a的2个较高值和b的3个最低值将给出Nout = 2 + 3 = 5的可能解。
这对应于例如6.2的阈值（曲线上的红线）

是否有R工具可以轻松地自动计算？

我在R ARCHIVE中找到了2个类似的工具：


不完整的软件包：
https://cran.r-project.org/src/contrib/Archive/ncomplete/（用于
完全分离）
Noverlap套件：
https://cran.r-project.org/src/contrib/Archive/noverlap/（用于
准完全分离）


但是，它们似乎未经验证（代码以“ NO WARRANTY”开头，并且不在活动的R软件包列表中）

最佳答案

我认为median在这里很有用，尽管您需要根据遇到的3种一般情况来不同地应用它

case 1: distribution of values do not overlap
case 2: distribution of values in 1 group completely overlaps with distribution of values in other group
case 3: distribution of values partially overlap (the data example you gave)

在不同情况下如何应用median

case 1: median value of all values
case 2: median value of all values
case 3: median value of only overlapping values

您的数据和绘图功能

plotfun <- function(df) {
    with(df, boxplot(Values~Groups))
    with(df, points(Values~Groups, cex=2))
}

df<-data.frame(Values = c(1,2,3,4,5,6,7,10,4,5.5,6,6.5,8,9,12),
            Groups = c(rep("a",8),rep("b",7)))
df
plotfun(df)

主力功能是myfun。它将确定3种情况中的哪一种是相关的，然后相应地应用中位数。如果您的值不是整数，则可以提供其他参数unitofchange。也就是说，也许您正在处理以0.1递增的数据。

library(dplyr)
myfun <- function(df, unitofchange=1) {
    unitofchange <- unitofchange / 10
    require(dplyr)
    summarydf <- df %>%
            group_by(Groups) %>%
            summarise(min = min(Values), max = max(Values)) %>%
            arrange(min)

    if (summarydf$max[1] < summarydf$min[2]) {
        # Case 1: distributions do not overlap
        ans <- list(Break = median(df$Values), Nout = 0)
    } else if (summarydf$max[1] > summarydf$max[2]) {
        # Case 2: one distribution is completely between other distribution
        ans <- list(Break = median(df$Values))
        ans[["Break"]] <- modifyiftie(df, unitofchange, ans[["Break"]])
        ans["Nout"] <- sum(df$Values < ans[["Break"]])
    } else {
        # Case 3: distributions partially overlap
        subset_df <- df %>%
                filter(between(Values, summarydf$min[2], summarydf$max[1]))
        ans <- list(Break = median(subset_df$Values))
        ans[["Break"]] <- modifyiftie(df, unitofchange, ans[["Break"]])
        ans["Nout"] <- sum(subset_df$Values[subset_df$Groups == summarydf$Groups[1]] > ans[["Break"]],
                    subset_df$Values[subset_df$Groups == summarydf$Groups[1]] < ans[["Break"]])
    }
    return(ans)
}

在您给出的示例中，在两组中都找到了分离值的情况下，我还包括了另一个函数modifyiftie

modifyiftie <- function(df, unitofchange, b) {
    require(dplyr)
    tie <- df %>%
        group_by(Groups) %>%
        filter(Values == b)

    if (nrow(tie) > 0 & all(unique(tie$Groups) %in% unique(df$Groups))) {       # tie is true
        return(b + unitofchange)
    } else {
        return(b)
    }
}

3种不同情况的输出

情况3：您的数据

df<-data.frame(Values = c(1,2,3,4,5,6,7,10,4,5.5,6,6.5,8,9,12),
            Groups = c(rep("a",8),rep("b",7)))
df
myfun(df)

# $Break
# [1] 6.1

# $Nout
# [1] 5

情况1：分布不重叠

set.seed(1)
df<-data.frame(Values = c(runif(10)*10, (runif(10)*10)+10),
            Groups = rep(c("a","b"), each=10))
plotfun(df)
myfun(df)

# $Break
# [1] 10.60616

# $Nout
# [1] 0

情况2：一组的分配介于另一组的分配之间

set.seed(1)
df<-data.frame(Values = c((runif(10)*5)+5, runif(10)*20),
            Groups = rep(c("a","b"), each=10))
plotfun(df)
myfun(df)

# $Break
# [1] 8.22478

# $Nout
# [1] 10

关于r - 如何在R中计算要删除的最小观察数，以实现两组之间的完全可分离性，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/47228196/