How to compute in R the minimum number of observations to be removed to achieve complete separability between 2 groups

user_3922577 0
Viewed 161

Problem: to compute in R the minimum number of observations to be removed to achieve complete separation between 2 groups (Nout).

Eg: 

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.

In that case, removing the 2 higher values of a and 3 lowest values of b gives a possible solution with Nout = 2 + 3 = 5. This corresponds to treshold value of for example 6.2 (red line on the plot)

Is there a R tool to easily compute that automatically?

I found 2 similar tools in R ARCHIVE:

They seem however not validated (code start by "NO WARRANTY", and are not in active R package list)

classification overlap r
1 Answers

I think median is useful here, although you need to apply it differently based on the 3 general cases you'll encounter

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)

How you'll need to apply the median in the different cases follows

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

Your data and your plot function

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)

The workhorse function is myfun. It will determine which of the 3 cases is relevant, and then apply the median accordingly. You can supply an additional argument unitofchange in case your values are not integers. That is, perhaps you're dealing with data that increments by 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)
}

I also included another function modifyiftie in cases like the example you gave where the separation value is found in both groups

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)
    }
}

Output of the 3 different cases

Case 3: Your data

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

Case 1: Distributions do not overlap

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

Case 2: Distribution of one group falls in between distribution of other group

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
user_79583560
Related