tourgroups.R

# my solution to https://github.com/thoughtfulbloke/tourgroups

library(dplyr)
library(tidyr)

tours <- read.csv("tours.csv",stringsAsFactors = FALSE)
visitors <- read.csv("visitors.csv",stringsAsFactors = FALSE)

# make it about choices

visilong <- visitors %>% 
  gather(choice,Group, choice1:choice5) %>%
  filter(!is.na(Group)) %>% arrange(Visitor, choice)

# calculate interest in each tour
tour_interest <- visilong %>% 
  count(Group) %>% inner_join(tours, by="Group") %>%
  mutate(ttricky = n-Max_people) %>%
  select(Group, ttricky, Max_people)

# calculate which Visitors are interested in the most oversubscribed tours
visitor_interest <- visilong %>% inner_join(tour_interest, by="Group") %>%
  group_by(Visitor) %>% summarise(vtricky = mean(ttricky)) %>% arrange(desc(vtricky))

# for each visitor, in order of wanting to go on to the most oversubscribed tours
# assign them to the most oversubscribed tour they want to go on
# basically, always do the hardest to fill ones before the easier ones
visilong$assigned <- NA_character_
for (person in visitor_interest$Visitor){
  bookings <- visilong %>% count(assigned) %>% rename(Group=assigned, booked=n)
  pick <- visilong %>% 
    filter(Visitor == person) %>%
    left_join(tour_interest, by="Group") %>%
    left_join(bookings, by="Group") %>%
    mutate(booked=ifelse(is.na(booked),0,booked)) %>%
    filter(booked < Max_people) %>%
    arrange(desc(ttricky)) %>% slice(1)
  visilong <- visilong %>% 
    mutate(assigned = ifelse(Visitor == person & Group==pick$Group[1], pick$Group[1], assigned)) %>%
    filter(Visitor != person | (Visitor == person & !is.na(assigned)))
  
}

outcome <- visitors %>% inner_join(visilong %>% select(Visitor,assigned), by="Visitor") 
# checks on outcome
summarise(outcome,sum(is.na(assigned)))
outcome %>% rename(Group=assigned) %>% count(Group) %>% rename(assigned=n) %>% 
  inner_join(tours, by="Group") %>% summarise(sum(assigned > Max_people))