Загадка парикмахера

Моя парикмахерская Стейси всегда выглядит счастливой, но ей часто не хватает времени. Сегодня Стейси была запоздалой на мое назначение и очень извинялась. Во время стрижки я подумала: как долго должны проходить ее стандартные встречи? (если предпочтение клиента на чистые круглые числа может быть проигнорировано, на мгновение).

Следует учитывать определенный «волновой эффект», при котором один очень поздний клиент может привести к ряду отложенных встреч. На самом деле, парикмахеры интуитивно учатся проводить встречи на расстоянии дольше и дольше, поскольку они боятся этих стрессовых дней. Но какой-то статистический гений должен достичь оптимального, элегантного решения ... (если мы немного заглушим реальность)

Давайте предположим

а) время стрижки волос обычно распределяется и

б) есть только один парикмахер

Слишком долгая стоимость назначения встреч - это, очевидно, время, затраченное парикмахером на ожидание следующей встречи. Давайте потратим впустую потраченное время 1 доллар за минуту.

Но если встреча не будет достаточно продолжительной, следующий клиент будет ждать, что для любящей клиента Стейси будет стоить дороже 3 доллара в минуту.

• Стейси работает до 8 часов в день, и у нее достаточно требований, чтобы она могла назначить столько встреч, сколько сможет

• Средняя стрижка занимает у нее 30 минут, с обычной. Dev 10 минут. (Давайте также предположим, что мужские порезы и женские порезы одинаковы!)

РЕДАКТИРОВАТЬ - некоторые справедливо отметили, что Стейси может обслуживать ранних клиентов раньше назначенного времени. Это добавляет еще один уровень сложности, но если мы рассматриваем это как вполне реальную проблему, мы должны включить ее. Давайте забудем мое предположение 90/10 и попробуем предположить, возможно, немного ближе к реальности.

• Некоторые клиенты опаздывают, а некоторые рано. Среднее количество клиентов опаздывает на 2 минуты со стандартным отклонением 2 минуты (звучит разумно близко к реальности, нет?)

Как долго должно быть ее назначение?

@alexplanation извините, я переместил ваши посты! Я уверен, что читатели R ценят ваш ответ.

В этой задаче много движущихся частей, что делает ее созревшей для симуляции.

Во-первых, как отметил Элвис в комментариях, Стейси должно быть около 16 встреч, каждый из которых занимает около получаса. Но вы знаете, что, поскольку встречи начинают затягиваться, вещи начинают меняться позже и позже - поэтому, если Стейси собирается начать встречу, только если у нее осталось полчаса (так много для подметания волос с пола, а, Стейси ?) тогда у нас будет менее 16 возможных слотов, если мы будем использовать хрустальный шар для планирования встреч без времени отдыха.

В следующем моделировании мы можем исследовать кривую стоимости как функцию длительности назначения. Конечно, остальные параметры также в конечном итоге сыграют свою роль - и на самом деле Стейси не собирается планировать свои встречи с интервалом в несколько минут, но это дает нам некоторую интуицию о том, что происходит.

Я также обозначил время, когда Стейси должна быть на работе, в качестве цвета. Я решил, что Стейси никогда не назначит свою последнюю встречу после 7:30, но иногда встреча появляется поздно, или была задержка! Вы можете видеть, что время, которое она добирается до дома, квантуется, так что, поскольку встречи становятся длиннее, вы получаете на одну встречу меньше, и тогда вам не придется работать так поздно. И я думаю, что здесь отсутствует элемент - может быть, планирование ваших встреч с интервалом в 45 минут - это здорово, но вы получите дополнительное назначение, если вы сможете сократить его до 40. Эта стоимость включена в ожидание Стейси (именно поэтому стоимость идет по мере увеличения продолжительности встречи) но ваша оценка времени ожидания Стейси может быть неверной.

Во всяком случае, веселая проблема! И хороший способ изучить некоторые достоинства ggplot и помнить, что мой синтаксис R супер шаток. :)

Мой код ниже - пожалуйста, не стесняйтесь предлагать предложения по улучшению.

Чтобы сгенерировать код для верхнего графика:

hairtime = 30
hairsd = 10

nSim = 1000
allCuts = rep(0,nSim)
allTime = rep(0,nSim)

for (i in 1:nSim) {
    t = 0
    ncuts = 0

    while (t < 7.5) {
        ncuts = ncuts+1
        nexthairtime = rnorm(1,hairtime,hairsd)
        t = t+(nexthairtime/60)
    }
    allCuts[i] = ncuts
    allTime[i] = t
}

hist(allCuts,main="Number of haircuts in an 8 hour day",xlab="Customers")

Вторая симуляция намного длиннее ...

nSim = 100
allCuts = rep(0,nSim)
allTime = rep(0,nSim)

allCost = rep(0,nSim)

lateMean = 10
lateSD = 3

staceyWasted = 1
customerWasted = 3

allLengths = seq(30,60,0.25)

# Keep everything in 'long form' just to make our plotting lives easier later
allApptCosts = data.frame(matrix(ncol=3,nrow=length(allLengths)*nSim))
names(allApptCosts) <- c("Appt.Length","Cost","Time")
ind = 1

# for every appointment length...
for (a in 1:length(allLengths)) {
    apptlen = allLengths[a]
    # ...simulate the time, and the cost of cutting hair.
    for (i in 1:nSim) {
        appts = seq(from=0,to=(8-hairtime/60),by=apptlen/60)
        t = 0
        cost = 0
        ncuts = 0

        for (a in 1:length(appts)) {
            customerArrival = appts[a]
            # late!            
            if (runif(1)>0.9) {
                customerArrival = appts[a]+rnorm(1,lateMean,lateSD)/60
            }

            waitTime = t-customerArrival
            # negative waitTime means the customer arrives late
            cost = cost+max(waitTime,0)*customerWasted+abs(min(waitTime,0))*staceyWasted
                                        # get the haircut
            nexthairtime = rnorm(1,hairtime,hairsd)
            t = customerArrival+(nexthairtime/60)
        }
        allCost[i] = cost
        allApptCosts[ind,1] = apptlen
        allApptCosts[ind,2] = cost
        allApptCosts[ind,3] = t
        ind = ind+1
    }
}

qplot(Appt.Length,Cost,geom=c("point"),alpha=I(0.75),color=Time,data=allApptCosts,xlab="Appointment Length (minutes)",ylab="Cost")+
      geom_smooth(color="black",size=2)+
    opts(axis.title.x=theme_text(size=16))+
    opts(axis.title.y=theme_text(size=16))+
    opts(axis.text.x=theme_text(size=14))+
    opts(axis.text.y=theme_text(size=14))+
    opts(legend.text=theme_text(size=12))+
    opts(legend.title=theme_text(size=12,hjust=-.2))