как вычислить медиану на сгруппированном наборе данных?

Question

Мой набор данных выглядит следующим образом:

salary number 
1500-1600 110 
1600-1700 180 
1700-1800 320 
1800-1900 460 
1900-2000 850 
2000-2100 250 
2100-2200 130 
2200-2300 70 
2300-2400 20 
2400-2500 10 

Как я могу вычислить медиану этого набора данных? Вот что я пробовал:

x <- c(110, 180, 320, 460, 850, 250, 130, 70, 20, 10) 
colnames <- "numbers" 
rownames <- c("[1500-1600]", "(1600-1700]", "(1700-1800]", "(1800-1900]", 
       "(1900-2000]", "(2000,2100]", "(2100-2200]", "(2200-2300]", 
       "(2300-2400]", "(2400-2500]") 
y <- matrix(x, nrow=length(x), dimnames=list(rownames, colnames)) 
data.frame(y, "cumsum"=cumsum(y)) 

      numbers cumsum 
[1500-1600]  110 110 
(1600-1700]  180 290 
(1700-1800]  320 610 
(1800-1900]  460 1070 
(1900-2000]  850 1920 
(2000,2100]  250 2170 
(2100-2200]  130 2300 
(2200-2300]  70 2370 
(2300-2400]  20 2390 
(2400-2500]  10 2400 

Здесь вы можете увидеть на полпути частота 2400/21200 =. Он находится между 1070 и 1920. Таким образом, средний класс - это группа (1900-2000]. Вы можете использовать формулу, приведенную ниже, чтобы получить этот результат:

Median = L + H/F (п/2 - с)

где:

л является нижняя граница класса медианного класса
h - размер медианного класса, т.е. разница между границами верхнего и нижнего классов медианного класса
е частота медианного класса
с является предыдущей накопленной частотой медианного класса
п/2 тотально нет. наблюдений, деленное на 2 (т.е. сумма е/2)

В качестве альтернативы, средний класс определяется следующим способом:

Расположить N/2 в столбце накопленной частоты.

Получить класс, в котором это лежит.

И в коде:

> 1900 + (1200 - 1070)/(1920 - 1070) * (2000 - 1900)  
[1] 1915.294 

Теперь то, что я хочу сделать, это сделать выше выражение более изящным - т.е. 1900+(1200-1070)/(1920-1070)*(2000-1900). Как я могу это достичь?

Answer 1

Поскольку вы уже знаете формулу, вам должно быть достаточно просто создать функцию для расчета для вас.

Здесь я создал базовую функцию, чтобы вы начали.Функция принимает четыре аргумента:

• frequencies: вектор частот («число» в первом примере)
• intervals: 2-строка matrix с тем же числом столбцов, как длина частот, с первая строка является границей нижнего класса, а вторая строка является границей верхнего класса. Альтернативно, «intervals» может быть столбцом в вашем data.frame, и вы можете указать sep (и, возможно, trim), чтобы функция автоматически создала требуемую матрицу для вас.
• sep: Символ разделителя в колонке «intervals» в вашем data.frame.
• trim: Регулярное выражение символов, которое необходимо удалить, прежде чем пытаться принудить к числовой матрице. Один шаблон встроен в функцию: trim = "cut". Это устанавливает шаблон регулярного выражения для удаления (,), [, и] с входа.

Вот функция (с комментариями, показывая, как я использовал свои инструкции, чтобы положить его вместе):

GroupedMedian <- function(frequencies, intervals, sep = NULL, trim = NULL) { 
    # If "sep" is specified, the function will try to create the 
    # required "intervals" matrix. "trim" removes any unwanted 
    # characters before attempting to convert the ranges to numeric. 
    if (!is.null(sep)) { 
    if (is.null(trim)) pattern <- "" 
    else if (trim == "cut") pattern <- "\\[|\\]|\\(|\\)" 
    else pattern <- trim 
    intervals <- sapply(strsplit(gsub(pattern, "", intervals), sep), as.numeric) 
    } 

    Midpoints <- rowMeans(intervals) 
    cf <- cumsum(frequencies) 
    Midrow <- findInterval(max(cf)/2, cf) + 1 
    L <- intervals[1, Midrow]  # lower class boundary of median class 
    h <- diff(intervals[, Midrow]) # size of median class 
    f <- frequencies[Midrow]  # frequency of median class 
    cf2 <- cf[Midrow - 1]   # cumulative frequency class before median class 
    n_2 <- max(cf)/2    # total observations divided by 2 

    unname(L + (n_2 - cf2)/f * h) 
} 

---

Вот пример data.frame работать с:

mydf <- structure(list(salary = c("1500-1600", "1600-1700", "1700-1800", 
    "1800-1900", "1900-2000", "2000-2100", "2100-2200", "2200-2300", 
    "2300-2400", "2400-2500"), number = c(110L, 180L, 320L, 460L, 
    850L, 250L, 130L, 70L, 20L, 10L)), .Names = c("salary", "number"), 
    class = "data.frame", row.names = c(NA, -10L)) 
mydf 
#  salary number 
# 1 1500-1600 110 
# 2 1600-1700 180 
# 3 1700-1800 320 
# 4 1800-1900 460 
# 5 1900-2000 850 
# 6 2000-2100 250 
# 7 2100-2200 130 
# 8 2200-2300  70 
# 9 2300-2400  20 
# 10 2400-2500  10 

---

Теперь мы можем просто:

GroupedMedian(mydf$number, mydf$salary, sep = "-") 
# [1] 1915.294 

---

Вот пример функции в действии на некоторых составили данные:

set.seed(1) 
x <- sample(100, 100, replace = TRUE) 
y <- data.frame(table(cut(x, 10))) 
y 
#   Var1 Freq 
# 1 (1.9,11.7] 8 
# 2 (11.7,21.5] 8 
# 3 (21.5,31.4] 8 
# 4 (31.4,41.2] 15 
# 5 (41.2,51] 13 
# 6 (51,60.8] 5 
# 7 (60.8,70.6] 11 
# 8 (70.6,80.5] 15 
# 9 (80.5,90.3] 11 
# 10 (90.3,100] 6 

### Here's GroupedMedian's output on the grouped data.frame... 
GroupedMedian(y$Freq, y$Var1, sep = ",", trim = "cut") 
# [1] 49.49231 

### ... and the output of median on the original vector 
median(x) 
# [1] 49.5 

---

Кстати, с данными выборки, которую вы указали, где я думаю, что там было ошибка в одном из ваших диапазонов (все были разделены тире, кроме одного, который был разделен запятой), так как strsplit использует стандартное выражение по умолчанию для разделения, вы можете использовать эту функцию следующим образом:

x<-c(110,180,320,460,850,250,130,70,20,10) 
colnames<-c("numbers") 
rownames<-c("[1500-1600]","(1600-1700]","(1700-1800]","(1800-1900]", 
      "(1900-2000]"," (2000,2100]","(2100-2200]","(2200-2300]", 
      "(2300-2400]","(2400-2500]") 
y<-matrix(x,nrow=length(x),dimnames=list(rownames,colnames)) 
GroupedMedian(y[, "numbers"], rownames(y), sep="-|,", trim="cut") 
# [1] 1915.294 

Answer 2

Вы пробовали median или apply(yourobject,2,median), если это matrix или data.frame?

Answer 3

(Sal <- sapply(strsplit(as.character(dat[[1]]), "-"), 
           function(x) mean(as.numeric(x)))) 
[1] 1550 1650 1750 1850 1950 2050 2150 2250 2350 2450 
require(Hmisc) 
wtd.mean(Sal, weights = dat[[2]]) 
[1] 1898.75 
wtd.quantile(Sal, weights=dat[[2]], probs=0.5) 

Обобщение на взвешенную медианную область может потребовать поиска пакета, который имеет такой.

Answer 4

Как насчет этого пути? Создайте векторы для каждой шкалы зарплаты, предполагая равномерное распространение по каждой группе. Затем сделайте один большой вектор из этих векторов и возьмите медиану. Как и у вас, но немного другой результат. Я не математик, поэтому метод может быть неправильным.

dat <- matrix(c(seq(1500, 2400, 100), seq(1600, 2500, 100), c(110, 180, 320, 460, 850, 250, 130, 70, 20, 10)), ncol=3) 
median(unlist(apply(dat, 1, function(x) { ((1:x[3])/x[3])*(x[2]-x[1])+x[1] }))) 

Возвращает 1915,353

Answer 5

Я написал это так, чтобы четко объяснить, как это на стадии разработки. Добавлена ​​более компактная версия.

library(data.table) 

#constructing the dataset with the salary range split into low and high 
salarydata <- data.table(
    salaries_low = 100*c(15:24), 
    salaries_high = 100*c(16:25), 
    numbers = c(110,180,320,460,850,250,130,70,20,10) 
) 

#calculating cumulative number of observations 
salarydata <- salarydata[,cumnumbers := cumsum(numbers)] 
salarydata 
    # salaries_low salaries_high numbers cumnumbers 
    # 1:   1500   1600  110  110 
    # 2:   1600   1700  180  290 
    # 3:   1700   1800  320  610 
    # 4:   1800   1900  460  1070 
    # 5:   1900   2000  850  1920 
    # 6:   2000   2100  250  2170 
    # 7:   2100   2200  130  2300 
    # 8:   2200   2300  70  2370 
    # 9:   2300   2400  20  2390 
    # 10:   2400   2500  10  2400 

#identifying median group 
mediangroup <- salarydata[ 
    (cumnumbers - numbers) <= (max(cumnumbers)/2) & 
    cumnumbers >= (max(cumnumbers)/2)] 
mediangroup 
    # salaries_low salaries_high numbers cumnumbers 
    # 1:   1900   2000  850  1920 

#creating the variables needed to calculate median 
mediangroup[,l := salaries_low] 
mediangroup[,h := salaries_high - salaries_low] 
mediangroup[,f := numbers] 
mediangroup[,c := cumnumbers- numbers] 
n = salarydata[,sum(numbers)] 

#calculating median 
median <- mediangroup[,l + ((h/f)*((n/2)-c))] 
median 
    # [1] 1915.294 

Компактная версия -

EDIT: Изменены к функции на @ AnandaMahto-х внушения. Кроме того, использование более общих имен переменных.

library(data.table) 

#Creating function 

CalculateMedian <- function(
    LowerBound, 
    UpperBound, 
    Obs 
) 
{ 
    #calculating cumulative number of observations and n 
    dataset <- data.table(UpperBound, LowerBound, Obs) 

    dataset <- dataset[,cumObs := cumsum(Obs)] 
    n = dataset[,max(cumObs)] 

    #identifying mediangroup and dynamically calculating l,h,f,c. We already have n. 
    median <- dataset[ 
     (cumObs - Obs) <= (max(cumObs)/2) & 
     cumObs >= (max(cumObs)/2), 

     LowerBound + ((UpperBound - LowerBound)/Obs) * ((n/2) - (cumObs- Obs)) 
    ] 

    return(median) 
} 


# Using function 
CalculateMedian(
    LowerBound = 100*c(15:24), 
    UpperBound = 100*c(16:25), 
    Obs = c(110,180,320,460,850,250,130,70,20,10) 
) 
# [1] 1915.294 

Answer 6

Я думаю, что эта концепция должна с вами работать.

$salaries = array(
     array("1500","1600"), 
     array("1600","1700"), 
     array("1700","1800"), 
     array("1800","1900"), 
     array("1900","2000"), 
     array("2000","2100"), 
     array("2100","2200"), 
     array("2200","2300"), 
     array("2300","2400"), 
     array("2400","2500"), 
    ); 
$numbers = array("110","180","320","460","850","250","130","70","20","10"); 
$cumsum = array(); 
$n = 0; 
$count = 0; 
foreach($numbers as $key=>$number){  
$cumsum[$key] = $number;  
$n += $number; 
if($count > 0){ 
    $cumsum[$key] += $cumsum[$key-1];  
} 
++$count; 
} 

$classIndex = 0; 
foreach($cumsum as $key=>$cum){ 
if($cum < ($n/2)){ 
$classIndex = $key+1; 
} 
} 
$classRange = $salaries[$classIndex]; 
$L = $classRange[0]; 
$h = (float) $classRange[1] - $classRange[0]; 
$f = $numbers[$classIndex]; 
$c = $numbers[$classIndex-1]; 

$Median = $L + ($h/$f)*(($n/2)-$c); 
echo $Median;