Основная

Графический ABC-анализ

Все началось вот с этой статьи на Хабре — Как мы ABC анализ для ритейла делали, или «без пол-литра не разберешься»
Очень понравилась идея с касательными.
Захотелось вспомнить аналитическую геометрию и сделать себе такой инструмент.
И у меня получилось, делюсь с вами.

Загрузим пакеты:

library(ggplot2)
library(dplyr)
library(zoo)

Создадим данные, по которым будем смотреть результаты работы:

set.seed(17)
mydata <- data.frame(id=1:120, sale=runif(120, 1, 9000000))

Теперь, чтобы не мучать кодом сразу покажу результаты работы.
Запускаем анализ

a_sale <- create_abc_mark(mydata, 'SALE')

Смотрим на результат разбиения по группам:
table(a_sale$dat$ABC_GROUP)

A B C
61 28 31

Стоп-стоп, скажете вы, а где же графический анализ ?
А он есть у меня: вот как его посмотреть можно:

a_sale$graph

Вот какая, КРАСОТА:
Rplot02

Теперь как оно сделано. Вы уж извините, дальше просто код. Все комментарии в коде вроде сделал, как думал и что делал, думаю понять можно:


create_abc_mark <- function(dat,txt_label)
{
# Преобразуем вход
tmp_colnames <- colnames(dat)
colnames(dat) <- c('id','value')
# Сдвинем данные вверх, чтобы избавиться от отрицательных значений
# для классификации это не важно
dat$value <- dat$value+ifelse(min(dat$value)<0, abs(min(dat$value)),0)

# Сортируем по desc(value)
dat <- arrange(dat,desc(value))

# Создадим порядковый индекс
dat$ind <- index(dat)

# Считаем процент по строке, накопительный процент
mx <- sum(dat$value)
dat$val_percent <- dat$value/mx
dat$val_cumpercent <- cumsum(dat$val_percent)

###################### РАЗБИЕНИЕ 1 ###################################
# Уравнение линии
my_line <- function(a,b,x) {return (a+b*x)}

# Возьмем точки начала и конца отрезка
df_1 <- data.frame(x=c(1,nrow(dat)), y=c(dat[1,'val_cumpercent'],dat[nrow(dat),'val_cumpercent']))

# Аналитическое построение опорной линии
m_1 <- lm(y~x, data = df_1)
a_1 <- as.numeric(m_1$coefficients[1])
b_1 <- as.numeric(m_1$coefficients[2])

# Проставим точки первой опорной линии
line_1 <- data.frame(x=1:nrow(dat), y=NA)
line_1$y <- my_line(a_1,b_1,line_1$x)

# Посчитаем разницу между кумулятивной кривой и опорной линии
diff_1 <- data.frame(x=line_1$x, y=line_1$y-dat$val_cumpercent)
# plot(diff_1) # В этом графике идея как посчитать точку касания
# Теперь, имея координаты точки касания и уравнение параллельной (опорной) прямой,
# считаем свободный член для уравнения касательной...
int_point_1 <- data.frame(
x=diff_1[diff_1$y==min(diff_1$y),]$x,
y=dat[diff_1[diff_1$y==min(diff_1$y),]$x,]$val_cumpercent)
tangent_a_1 <- int_point_1$y-b_1*int_point_1$x
tangent_line_1 <- data.frame(
x=dat$ind,
y=my_line(tangent_a_1,b_1,dat$ind))

###################### РАЗБИЕНИЕ 2 ###################################
# Возьмем точки начала и конца отрезка
df_2 <- data.frame(x=c(int_point_1$x+1,nrow(dat)), y=c(dat[int_point_1$x+1,'val_cumpercent'],dat[nrow(dat),'val_cumpercent']))

# Аналитическое построение опорной линии
m_2 <- lm(y~x, data = df_2)
a_2 <- as.numeric(m_2$coefficients[1])
b_2 <- as.numeric(m_2$coefficients[2])

# Проставим точки первой опорной линии
line_2 <- data.frame(x=df_2[1,'x']:df_2[2,'x'], y=NA)
line_2$y <- my_line(a_2,b_2,line_2$x)

# Посчитаем разницу между кумулятивной кривой и опорной линии
diff_2 <- data.frame(x=line_2$x, y=line_2$y-dat[dat$ind>=df_2[1,'x'],]$val_cumpercent)

# Теперь, имея координаты точки касания и уравнение параллельной (опорной) прямой,
# считаем свободный член для уравнения касательной...
int_point_2 <- data.frame(
x=diff_2[diff_2$y==min(diff_2$y),]$x,
y=dat[diff_2[diff_2$y==min(diff_2$y),]$x,]$val_cumpercent)
tangent_a_2 <- int_point_2$y-b_2*int_point_2$x
tangent_line_2 <- data.frame(
x=line_2$x,
y=my_line(tangent_a_2,b_2,line_2$x))

# Проставляем группы
dat$abc_group <- "C"
dat[dat$ind<=int_point_2$x,]$abc_group <- "B"
dat[dat$ind<=int_point_1$x,]$abc_group <- "A"

################################################################################################
# ВЫВОД ДАННЫХ
################################################################################################
# Собираем данные в кучу для графиков
g_curve <- dat[,c('ind','val_cumpercent')]
g_base_1 <- df_1
g_tangent_1 <- tangent_line_1[tangent_line_1$y<1.2,]
g_dotted_x_1 <- data.frame(x=rep(int_point_1$x,2), y=c(0, int_point_1$y))
g_dotted_y_1 <- data.frame(x=c(0,int_point_1$x), y=rep(int_point_1$y,2))

g_base_2 <- df_2
g_tangent_2 <- tangent_line_2[tangent_line_2$y<1.2,]
g_dotted_x_2 <- data.frame(x=rep(int_point_2$x,2), y=c(0, int_point_2$y))
g_dotted_y_2 <- data.frame(x=c(0,int_point_2$x), y=rep(int_point_2$y,2))

# Рисуем расчет
p <- ggplot()+theme_bw()+ggtitle(paste('Расчет зон для',txt_label))+
geom_line(aes(x=ind, y=val_cumpercent), data = g_curve, col='black')+
######################################################################################
geom_line(aes(x=x, y=y), data = g_base_1,col='green')+
geom_line(aes(x=x, y=y), data = g_tangent_1,col='green')+
geom_point(aes(x=x, y=y), data = g_dotted_x_1[2,],col='darkgreen',size=3)+
geom_line(aes(x=x, y=y), data = g_dotted_x_1,col='darkgreen', linetype=2)+
geom_line(aes(x=x, y=y), data = g_dotted_y_1,col='darkgreen', linetype=2)+
######################################################################################
geom_line(aes(x=x, y=y), data = g_base_2,col='blue')+
geom_line(aes(x=x, y=y), data = g_tangent_2,col='blue')+
geom_point(aes(x=x, y=y), data = g_dotted_x_2[2,],col='darkblue',size=3)+
geom_line(aes(x=x, y=y), data = g_dotted_x_2,col='darkblue', linetype=2)+
geom_line(aes(x=x, y=y), data = g_dotted_y_2,col='darkblue', linetype=2)

################################################################################################
# Возврат функции
################################################################################################
dat <- dat[,c('id','abc_group')] colnames(dat) <- c(tmp_colnames[1],'ABC_GROUP') return(list(dat=dat, graph=p)) }

Графический ABC-анализ: 5 комментариев

  1. увы, если у вас получается 61% элементов в классе А, значит расчеты выполнены неверно. Класс А составляют НЕМНОГОЧИСЛЕННЫЕ, но самые важные элементы анализируемой совокупности. Даже в самом критическом случае их число не может превышать 33% (как получается при равномерном распределении)

    1. Спасибо за мнение. Вы нашли в статье мотиваторе рассказ про алгоритм про касательные?

      В данной работе мне захотелось лишь создать Инструмент, а вопрос его применимости либо не применимости к конкретной ситуации может быть решён Человеком.

      Ps. Все дело в форме кумулятивной кривой. В жизни она не такая как в моей статье 🙂 И инструмент вполне годный и применяется…

      1. Добрый день, admin. Не имею каких-либо навыков в R, но требуется внедрить в BI систему spotfire АВС анализ именно методом касательных. Помогите решить задачу. Спс.

        1. Могу предложить изучать R 🙂 Но ничего не знаю про систему sportfire, интегрируется ли оно с R… либо реализовывать во встроенном языке, если там он есть…
          математически метод понятен по статье, на основе которой написан этот пост…

          1. Спасибо за ответ. Tibko spotfire имеет внутри себя встроенный редактор R, и позволяет использовать пакеты от cran.
            Попробуем использовать ваш код.

Добавить комментарий