Изменить форму броска сравнить с одним уровнем

Question

У меня часто есть данные, где я хочу сравнить значение одного уровня переменной со всеми другими уровнями переменной. Каждый раз, когда я пишу код для этого, я бы хотел, чтобы это было проще. Вот пример проблемы:

Предположим, я хочу сравнить среднюю стоимость бриллиантов любой огранки со средней стоимостью бриллиантов наилучшей огранки. Чтобы сделать вещи честными, я хочу сделать это для каждой ясности, отдельно.

Давайте проверим, у нас достаточно данных:

> with(diamonds,table(cut,clarity))
           clarity
cut           I1  SI2  SI1  VS2  VS1 VVS2 VVS1   IF
  Fair       210  466  408  261  170   69   17    9
  Good        96 1081 1560  978  648  286  186   71
  Very Good   84 2100 3240 2591 1775 1235  789  268
  Premium    205 2949 3575 3357 1989  870  616  230
  Ideal      146 2598 4282 5071 3589 2606 2047 1212

хорошо, в нуле нет нулей, так что давайте посчитаем среднее.

> claritycut<-ddply(diamonds,.(clarity,cut),summarize,price=mean(price))
> claritycut
   clarity       cut    price
1       I1      Fair 3703.533
2       I1      Good 3596.635
3       I1 Very Good 4078.226
4       I1   Premium 3947.332
5       I1     Ideal 4335.726
6      SI2      Fair 5173.916
7      SI2      Good 4580.261
8      SI2 Very Good 4988.688
9      SI2   Premium 5545.937
10     SI2     Ideal 4755.953
...

Конечный результат, который я хочу:

   clarity  variable     ratio
1       I1      Fair 0.8541899
2       I1      Good 0.8295348
3       I1 Very Good 0.9406098
4       I1   Premium 0.9104200
5       I1     Ideal 1.0000000
6      SI2      Fair 1.0878822
7      SI2      Good 0.9630586
8      SI2 Very Good 1.0489356
9      SI2   Premium 1.1661043
10     SI2     Ideal 1.0000000
...

Но я не уверен, как это сделать аккуратно. Большая часть остальной части этого вопроса касается промежуточного шага в расчете - деления.

Теперь я хочу вычислить относительную цену всех сокращений по сравнению с Идеалами. Вот кадр данных, который я ожидаю увидеть в процессе вычислений - извлекая только один уровень разреза:

> claritycutideal <- join(subset(claritycut,cut!="Ideal"),summarize(subset(claritycut,cut=="Ideal"),Ideal=price,clarity))
> print(claritycutideal)
Joining by: clarity
   clarity       cut    price    Ideal
1       I1      Fair 3703.533 4335.726
2       I1      Good 3596.635 4335.726
3       I1 Very Good 4078.226 4335.726
4       I1   Premium 3947.332 4335.726
5      SI2      Fair 5173.916 4755.953
6      SI2      Good 4580.261 4755.953
7      SI2 Very Good 4988.688 4755.953
8      SI2   Premium 5545.937 4755.953
...

Что работает, но написать вышеупомянутое утверждение нелегко, и мне все еще нужно закончить вычисление, снова упомянув Идеальное имя.

> mutate(claritycutideal,ratio=price/Ideal)

Такое ощущение, что я хочу что-то вроде

> cast(claritycut,clarity~cut)
Using clarity, cut as id variables
  clarity     Fair     Good Very Good  Premium    Ideal
1      I1 3703.533 3596.635  4078.226 3947.332 4335.726
2     SI2 5173.916 4580.261  4988.688 5545.937 4755.953
3     SI1 4208.279 3689.533  3932.391 4455.269 3752.118
4     VS2 4174.724 4262.236  4215.760 4550.331 3284.550
...

Это совершенно не подходит для вычисления среднего значения, так как мне нужно знать имена всех измененных уровней в расчете:

Я бы хотел изменить, но с возможностью фильтровать извлеченные уровни и оставить остальные нетронутыми , например:

> cast(claritycut,clarity~cut,subset=cut=="Ideal")

Который существует, но не сохраняет нефильтрованные уровни.

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

У кого-нибудь есть хитрый трюк для этого?

Или, может быть, я смотрю на это совершенно неправильно - маргинальные вычисления делают это для меня?

---

Следующие работы точно правильны , но неуверенно:

> valuevars=function(x)x[!names(x)%in%attr(x,"idvars")]
> melt(ddply(cast(claritycut,clarity~cut),.(clarity),
             function(x)valuevars(x)/x$Ideal))

Answer 1

Я не уверен, что это достаточно аккуратно, но есть два лайнера:

# from your code
claritycut <- ddply(diamonds,.(clarity,cut),summarize,price=mean(price))

# 1 do that work
transform(merge(claritycut, subset(claritycut, cut=="Ideal"), by="clarity"),
  ratio = price.x / price.y)

# 2 another way
ddply(claritycut, .(clarity), 
      function(x) data.frame(cut=x$cut, 
                             rate=x$price / subset(x, cut == "Ideal")$price))

# 3 another way
ddply(claritycut, .(clarity), 
      summarize, cut=cut, rate=price / price[cut == "Ideal"])

и, наконец, 4) вот однострочная версия:

ddply(diamonds, .(clarity), 
      function(x) transform(ddply(x, .(cut), 
                                  summarize, rate=mean(price)), 
                            rate=rate/mean(subset(x, cut=="Ideal")$price)))

но слишком сложно.

Answer 2

Вам не нужно знать, сколько уровней можно разделить после каста, 2:ncol(x) позаботится об этом.Однострочные решения здесь, хотя и лаконичны, не очень понятны.Постарайтесь не заставлять ваш код быть элегантным, но достаточно понятным.Я обнаружил, что когда что-то слишком красивое, потом его сложнее воспроизвести.

x <- cast(diamonds, clarity ~ cut + ., mean, value="price")
x <- cbind(x[1],x[2:ncol(x)]/x$Ideal)
x <- melt(x) 

или:

x <- cast(diamonds, clarity ~ cut + ., mean, value="price")
x <- melt(cbind(x[1],x[2:ncol(x)]/x$Ideal)) # The last two as one step

Answer 3

Это делает что-то интересное с выражением args to dlply.

summarize(do.call(merge,c(by="clarity",
                          dlply(
                                ddply(diamonds,.(clarity,cut),
                                      summarize,meanp=mean(price)),
                                .(ifelse(cut!="Ideal","x","y"))))),
          clarity,cut=cut.x,ratio=meanp.x/meanp.y)

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