如何获得一辆汽车的 mpg 比其他汽车最低的概率?
How to get the probabilities of one car having the lowest mpg than the rest of the cars?
我正在使用它来获取汽车 mpg 的均值和标准差
df1 <- mtcars; df1$rownames = rownames(df1)
df2 <- mtcars; df2$rownames = rownames(df2)
df2$mpg = df2$mpg + rnorm(nrow(df2),0,3)
data = rbind(df1, df2)
我使用一个函数来获取一辆汽车的 mpg 低于其他汽车的概率
df = plyr::ddply(data,~rownames,summarise,mean=mean(mpg),sd=sd(mpg))
f <- function(x, y){
n1 = df$mean[x]; n2 = df$mean[y]; sd1 = df$sd[x]; sd2 = df$sd[y]
pnorm(0, mean = n1 - n2, sd = sqrt(sd1^2 + sd2^2))
}
res <- outer(X = 1:nrow(df), Y = 1:nrow(df), f)
dimnames(res) <- list(df$rownames, df$rownames)
res <- data.frame(res)
res <- tibble::rownames_to_column(res, 'p1')
datalong_2 <- tidyr::gather(res, 'p2', 'value', -1) # output
现在我想要一辆汽车的 mpg 比其他汽车最低的概率。我绑这个:
cars = unique(datalong_2$p1)
win <- data.frame(sapply(1:length(cars), function(x) setNames(prod(subset(datalong_2, p1 == cars[x] & p2 != cars[x])$value),cars[x])))
colnames(win) <- "prob"
win$prob <- round(win$prob,4)
但是概率加起来不为一。我如何更改此代码以获得 table 每辆汽车的 mpg 比其他汽车最低的概率?
这是 dplyr/data.table
方法与 return 概率
的比较
library(dplyr)
library(data.table)
library(tidyr)
library(tibble)
# // input data
df <- mtcars[1] %>%
rownames_to_column("car")
-测试
# // dplyr
system.time({
out <- df %>%
uncount(10000, .id = "run") %>%
rowwise() %>%
mutate(sim_mpg = rpois(1, lambda = mpg)) %>%
group_by(run) %>%
arrange(sim_mpg) %>%
mutate(lowest_mpg = row_number() == 1) %>%
group_by(car) %>%
summarize(chance_lowest = mean(lowest_mpg),
orig_mpg = first(mpg))
})
# user system elapsed
# 1.715 0.074 1.787
# // data.table
system.time({
df_expand <- setDT(df)[rep(seq_len(.N), 10000)][, run := rowid(car)]
out2 <- df_expand[, sim_mpg := rpois(1, lambda = mpg), 1:nrow(df_expand)
][order(sim_mpg), lowest_mpg := seq_len(.N) == 1 ,run
][, .(chance_lowest = mean(lowest_mpg), orig_mpg = first(mpg)), .(car)]
})
# user system elapsed
# 0.704 0.050 0.757
sum(out$chance_lowest)
#[1] 1
我正在使用它来获取汽车 mpg 的均值和标准差
df1 <- mtcars; df1$rownames = rownames(df1)
df2 <- mtcars; df2$rownames = rownames(df2)
df2$mpg = df2$mpg + rnorm(nrow(df2),0,3)
data = rbind(df1, df2)
我使用一个函数来获取一辆汽车的 mpg 低于其他汽车的概率
df = plyr::ddply(data,~rownames,summarise,mean=mean(mpg),sd=sd(mpg))
f <- function(x, y){
n1 = df$mean[x]; n2 = df$mean[y]; sd1 = df$sd[x]; sd2 = df$sd[y]
pnorm(0, mean = n1 - n2, sd = sqrt(sd1^2 + sd2^2))
}
res <- outer(X = 1:nrow(df), Y = 1:nrow(df), f)
dimnames(res) <- list(df$rownames, df$rownames)
res <- data.frame(res)
res <- tibble::rownames_to_column(res, 'p1')
datalong_2 <- tidyr::gather(res, 'p2', 'value', -1) # output
现在我想要一辆汽车的 mpg 比其他汽车最低的概率。我绑这个:
cars = unique(datalong_2$p1)
win <- data.frame(sapply(1:length(cars), function(x) setNames(prod(subset(datalong_2, p1 == cars[x] & p2 != cars[x])$value),cars[x])))
colnames(win) <- "prob"
win$prob <- round(win$prob,4)
但是概率加起来不为一。我如何更改此代码以获得 table 每辆汽车的 mpg 比其他汽车最低的概率?
这是 dplyr/data.table
方法与 return 概率
library(dplyr)
library(data.table)
library(tidyr)
library(tibble)
# // input data
df <- mtcars[1] %>%
rownames_to_column("car")
-测试
# // dplyr
system.time({
out <- df %>%
uncount(10000, .id = "run") %>%
rowwise() %>%
mutate(sim_mpg = rpois(1, lambda = mpg)) %>%
group_by(run) %>%
arrange(sim_mpg) %>%
mutate(lowest_mpg = row_number() == 1) %>%
group_by(car) %>%
summarize(chance_lowest = mean(lowest_mpg),
orig_mpg = first(mpg))
})
# user system elapsed
# 1.715 0.074 1.787
# // data.table
system.time({
df_expand <- setDT(df)[rep(seq_len(.N), 10000)][, run := rowid(car)]
out2 <- df_expand[, sim_mpg := rpois(1, lambda = mpg), 1:nrow(df_expand)
][order(sim_mpg), lowest_mpg := seq_len(.N) == 1 ,run
][, .(chance_lowest = mean(lowest_mpg), orig_mpg = first(mpg)), .(car)]
})
# user system elapsed
# 0.704 0.050 0.757
sum(out$chance_lowest)
#[1] 1