Используя R, как бросить несколько игральных костей и выбросить д ie с наименьшим броском? - PullRequest
Новая
       65

Используя R, как бросить несколько игральных костей и выбросить д ie с наименьшим броском?

0 голосов
/ 20 апреля 2020

Используя R, я хотел бы помочь друзьям визуализировать вероятности, связанные с кубиками для игр. Однако я не знаю, как написать код на R, который позволил бы мне сделать следующее:

  • Бросить количество кубиков (например: 4 шестигранных кубика), отбросить d ie с наименьшим броском и добавьте остальные.

Такое чувство, что это должно быть довольно просто сделать, но я пока не нашел способ сделать это.

Ответы [ 2 ]

2 голосов
/ 20 апреля 2020 
sum(sort(sample(6, size = 4, replace = TRUE), partial = 1)[-1])

Чтобы увидеть, что это делает, мы будем использовать stati c seed и пройдемся по всему этому. 

### four six-sided dice
set.seed(6); sample(6, size = 4, replace = TRUE)
# [1] 4 6 2 3

### sort just the minimum to the front
set.seed(6); sort(sample(6, size = 4, replace = TRUE), partial = 1)
# [1] 2 3 6 4

### remove the minimum at the front
set.seed(6); sort(sample(6, size = 4, replace = TRUE), partial = 1)[-1]
# [1] 3 6 4

set.seed(6); sum(sort(sample(6, size = 4, replace = TRUE), partial = 1)[-1])
# [1] 13

(sort(..., partial=1) сортирует, пока не найден минимум и не поместит это в начале вектора, сортировка после этого не выполняется. Хотя это не требуется для задачи, без нее не требуется ненужная сортировка. Возьмите или оставьте ее: -)

Редактировать

Как предположил Брайан, по-видимому, разделяя мое стремление оптимизировать рано: 

x <- sample(6, size=4, replace=TRUE)
sum(x[-which.min(x)])

примерно в 8-10 раз быстрее, чем sort(...), и в 4-5 раз быстрее, чем sort(..., partial=1).

1 голос
/ 20 апреля 2020

Поскольку вопрос касается визуализации вероятностей, я выбрал другой подход. 

library(dplyr)
library(purrr)
library(ggplot2)

dice_roller <- function(n = 4, sides = 6, num_rolls = 1000) {
  tibble(
    rolls = rerun(num_rolls, sample.int(sides, n, replace = TRUE)),
    lowest = map_dbl(rolls, ~min(.x)),
    kept = map(rolls, ~.x[-which.min(.x)]),
    sum = map_dbl(kept, ~sum(.x))
  )
}

Эта функция принимает 3 аргумента: количество кубиков, тип кубиков и количество бросков.

  • Затем для каждого броска он делает выборку целых чисел на основе количества сторон, а размер образца - это количество игральных костей.
  • Затем он сопоставляет каждый бросок и находит минимальное значение, просто чтобы записать его для отображения.
  • Затем он отображается на каждом броске и говорит: дать мне весь этот вектор, кроме индекса минимального значения.
  • Затем он отображается на каждом векторе сохраненных значений, и записывает сумму.
  • И возвращает все это в кадре данных для будущего исследования.

Так что, если мы запустим эту функцию (и немного кода для отображения) : 

dice_roller() %>% 
  mutate_at(
    vars(rolls, kept), 
    ~map_chr(., paste, collapse = ",")
    )
#> # A tibble: 1,000 x 4
#>    rolls   lowest kept    sum
#>    <chr>    <dbl> <chr> <dbl>
#>  1 1,5,3,6      1 5,3,6    14
#>  2 2,5,3,5      2 5,3,5    13
#>  3 6,2,2,1      1 6,2,2    10
#>  4 1,1,5,4      1 1,5,4    10
#>  5 2,4,5,2      2 4,5,2    11
#>  6 1,1,3,1      1 1,3,1     5
#>  7 1,4,3,2      1 4,3,2     9
#>  8 1,3,4,3      1 3,4,3    10
#>  9 6,3,3,5      3 6,3,5    14
#> 10 3,4,6,5      3 4,6,5    15
#> # … with 990 more rows

Удобно, поэтому давайте посмотрим на вероятности! 

ggplot(dice_roller(), aes(sum)) +
  geom_histogram(binwidth = 1)


# Fewer dice per roll makes the distribution more skewed
ggplot(dice_roller(n = 3), aes(sum)) +
  geom_histogram(binwidth = 1)


# More dice approaches a "normal" distribution of integers
ggplot(dice_roller(n = 10), aes(sum)) +
  geom_histogram(binwidth = 1)


ggplot(dice_roller(num_rolls = 100000), aes(sum)) +
  geom_histogram(binwidth = 1)

Создано в 2 020-04-20 по представлению пакета (v0.3.0)

...