How can I calculate all possible joint probabilities given combination of objects, responses, and probabilities?

Question

I'm hoping to calculate the probabilities for each set of possible outcomes using a larger set of data similar to this:

dat<-data.frame(Fruit=c("Apple","Apple","Apple","Pear","Pear","Pear","Banana","Banana","Banana"),
            Pref=c("Love","Neut","Yuck","Love","Neut","Yuck","Love","Neut","Yuck"),
            Probability=c(.1,.2,.3,.4,.5,.6,.7,.8,.9))

Ultimately, I'm hoping to have a series that looks like:

In this series, the probability column is the product of the probability for each given condition being met in the row.

In solving this problem, these are problems that have made it difficult for me:

1. The number of fruit can be different on any given day. Sometimes, this can be as high as 15.
2. It is only possible to have a single opinion on each fruit, so combinations such as "Apple Neut - Apple Love - Pear Love" are impossible.

I looked at the answer here: All the possible outcomes , and find that the probabilities that are associated with my desired table do appear in here, but I don't know how to filter down to the results meeting my constraints, and don't see a means to clearly label. I've been experimenting with expand.grid and trying to repeat values using rep() but can't seem to get this working. I am a frequent user of dplyr so I'd likely understand an answer using the tidy format best, but any and all help would be greatly appreciated.

Answer 1

Here is a tidyverse solution. The generic approach to your problem is to run a series of Cartesian full_join s. We would first create a column of "Fruit-Pref" s, second split the dataframe into a list of sub-dataframes (by Fruit ), third full_join them all in a Cartesian way, and last calculate the joint probability.

library(dplyr)
library(purrr)

dat %>% 
  mutate(Pref = paste(Fruit, Pref, sep = "-")) %>% 
  split(.$Fruit) %>% 
  imap(~rename(.x, "{.y}Status" := Pref)) %>%
  reduce(full_join, by = character()) %>% 
  transmute(
    across(ends_with("Status")), 
    Probability = reduce(across(starts_with("Probability")), `*`)
  )

Output

   AppleStatus BananaStatus PearStatus Probability
1   Apple-Love  Banana-Love  Pear-Love       0.028
2   Apple-Love  Banana-Love  Pear-Neut       0.035
3   Apple-Love  Banana-Love  Pear-Yuck       0.042
4   Apple-Love  Banana-Neut  Pear-Love       0.032
5   Apple-Love  Banana-Neut  Pear-Neut       0.040
6   Apple-Love  Banana-Neut  Pear-Yuck       0.048
7   Apple-Love  Banana-Yuck  Pear-Love       0.036
8   Apple-Love  Banana-Yuck  Pear-Neut       0.045
9   Apple-Love  Banana-Yuck  Pear-Yuck       0.054
10  Apple-Neut  Banana-Love  Pear-Love       0.056
11  Apple-Neut  Banana-Love  Pear-Neut       0.070
12  Apple-Neut  Banana-Love  Pear-Yuck       0.084
13  Apple-Neut  Banana-Neut  Pear-Love       0.064
14  Apple-Neut  Banana-Neut  Pear-Neut       0.080
15  Apple-Neut  Banana-Neut  Pear-Yuck       0.096
16  Apple-Neut  Banana-Yuck  Pear-Love       0.072
17  Apple-Neut  Banana-Yuck  Pear-Neut       0.090
18  Apple-Neut  Banana-Yuck  Pear-Yuck       0.108
19  Apple-Yuck  Banana-Love  Pear-Love       0.084
20  Apple-Yuck  Banana-Love  Pear-Neut       0.105
21  Apple-Yuck  Banana-Love  Pear-Yuck       0.126
22  Apple-Yuck  Banana-Neut  Pear-Love       0.096
23  Apple-Yuck  Banana-Neut  Pear-Neut       0.120
24  Apple-Yuck  Banana-Neut  Pear-Yuck       0.144
25  Apple-Yuck  Banana-Yuck  Pear-Love       0.108
26  Apple-Yuck  Banana-Yuck  Pear-Neut       0.135
27  Apple-Yuck  Banana-Yuck  Pear-Yuck       0.162

---

Here is another not-so-generic-but-probably-easier-to-understand way. It requires you to specify the sets of Fruit s manually.

library(dplyr)
library(tidyr)

dat %>% 
  pivot_wider(names_from = Fruit, values_from = Probability) %>%
  expand(
    nesting(Apple, AppleStatus = paste0("Apple-", Pref)), 
    nesting(Pear, PearStatus = paste0("Pear-", Pref)), 
    nesting(Banana, BananaStatus = paste0("Banana-", Pref))
  ) %>% 
  transmute(
    across(ends_with("Status")), 
    Probability = Reduce(`*`, across(-ends_with("Status")))
  )

Answer 2

Try this base R code

with(
  dat,
  cbind(
    expand.grid(split(paste0(Fruit, "-", Pref), Fruit)),
    Probability = Reduce(`*`, expand.grid(split(Probability, Fruit)))
  )
)

which gives

        Apple      Banana      Pear Probability
1  Apple-Love Banana-Love Pear-Love       0.028
2  Apple-Neut Banana-Love Pear-Love       0.056
3  Apple-Yuck Banana-Love Pear-Love       0.084
4  Apple-Love Banana-Neut Pear-Love       0.032
5  Apple-Neut Banana-Neut Pear-Love       0.064
6  Apple-Yuck Banana-Neut Pear-Love       0.096
7  Apple-Love Banana-Yuck Pear-Love       0.036
8  Apple-Neut Banana-Yuck Pear-Love       0.072
9  Apple-Yuck Banana-Yuck Pear-Love       0.108
10 Apple-Love Banana-Love Pear-Neut       0.035
11 Apple-Neut Banana-Love Pear-Neut       0.070
12 Apple-Yuck Banana-Love Pear-Neut       0.105
13 Apple-Love Banana-Neut Pear-Neut       0.040
14 Apple-Neut Banana-Neut Pear-Neut       0.080
15 Apple-Yuck Banana-Neut Pear-Neut       0.120
16 Apple-Love Banana-Yuck Pear-Neut       0.045
17 Apple-Neut Banana-Yuck Pear-Neut       0.090
18 Apple-Yuck Banana-Yuck Pear-Neut       0.135
19 Apple-Love Banana-Love Pear-Yuck       0.042
20 Apple-Neut Banana-Love Pear-Yuck       0.084
21 Apple-Yuck Banana-Love Pear-Yuck       0.126
22 Apple-Love Banana-Neut Pear-Yuck       0.048
23 Apple-Neut Banana-Neut Pear-Yuck       0.096
24 Apple-Yuck Banana-Neut Pear-Yuck       0.144
25 Apple-Love Banana-Yuck Pear-Yuck       0.054
26 Apple-Neut Banana-Yuck Pear-Yuck       0.108
27 Apple-Yuck Banana-Yuck Pear-Yuck       0.162