Created
June 30, 2017 11:51
-
-
Save kevinsoo/10d39af399e88476966a96298a11af2d to your computer and use it in GitHub Desktop.
WeddingSeating
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #### This script takes a data frame of guest characteristics and assigns them to tables based on similarity | |
| # The 'GuestData.csv' should have the following columns: 'LastName', 'FirstName', 'Attribute1', 'Attribute2', etc. | |
| # Each attribute should be a vector of 1's and 0's | |
| # load packages | |
| library(tidyverse) | |
| library(reshape2) | |
| library(lsa) | |
| library(devtools) | |
| library(igraph) | |
| # load simulated annealing functions | |
| source_url("https://gist.githubusercontent.com/willycs40/7a7f9a073f2500001283/raw/b4f316ffe73b1bd24b941385305c291c13a9f823/Seating_Plan_Functions.R") | |
| # read data into data frame, create column for full names | |
| df <- read.csv("GuestData.csv") | |
| Name <- paste(df$LastName, df$FirstName, sep="") | |
| df <- data.frame(Name, df) | |
| # create matrix for weights | |
| guestMatrix <- matrix(rep(0, nrow(df)^2), nrow=nrow(df)) | |
| rownames(guestMatrix) <- Name | |
| colnames(guestMatrix) <- Name | |
| # calculate cosine similarity for each guest | |
| for (i in 1:nrow(df)) { | |
| for (j in 1:nrow(df)) { | |
| a <- as.numeric(df[i,4:ncol(df)]) # feature vector for guest i | |
| b <- as.numeric(df[j,4:ncol(df)]) # feature vector for guest j | |
| guestMatrix[i,j] <- cosine(a, b) # cosine similarity between guests i and j | |
| } | |
| } | |
| # reshape data for plotting | |
| meltedGuests <- data.frame(melt(guestMatrix)) | |
| colnames(meltedGuests) <- c("i", "j", "Compatibility") | |
| # plot weights for guest pairs | |
| ggplot(meltedGuests, aes(x=i, y=j, fill=Compatibility)) + | |
| geom_raster() + | |
| xlab("Guest #") + | |
| ylab("Guest #") + | |
| ggtitle("Who should sit together?") | |
| # average similarity for each guest (how connected they are) | |
| mg <- meltedGuests %>% group_by(i) %>% summarise(M=mean(Compatibility)) | |
| # increase weight for people who must sit together (husbands & wives, kids & parents) | |
| for (i in 1:nrow(df)) { | |
| for (j in 1:nrow(df)) { | |
| if (df$LastName[i]==df$LastName[j]) { # if guest i and j have the same last name | |
| guestMatrix[i,j] <- 99 # assign arbitrarily high weight of 99 | |
| } | |
| if (guestMatrix[i,j]==1) { # if guest i and j have the same characteristics | |
| guestMatrix[i,j] <- 99 # increase weight to 10 | |
| } | |
| } | |
| } | |
| #### assign seating using simulated annealing | |
| tables <- c(rep(10, 13)) # number of tables and capacity at each table | |
| C <- guestMatrix # rename guestMatrix for function | |
| n <- nrow(C) # number of rows | |
| # simulated annealing | |
| initialSolution <- initialiseSolution(nrow(guestMatrix), tables) | |
| initialSolution <- randomiseSolution(initialSolution) | |
| finalSolution <- simulatedAnnealing(initialSolution, evaluateEnergy, getNeighbour, 2000, 0.0001, 100000) | |
| # solution | |
| colnames(finalSolution) <- Name | |
| finalSolution <- t(finalSolution) | |
| finalSolution | |
| #### assign seating using graph partitioning | |
| graph <- meltedGuests %>% filter(Compatibility > 0.5) | |
| network <- graph.data.frame(graph, directed=F) | |
| plot(network) | |
| g <- set.edge.attribute(network, name="weight", value=graph$Compatibility) | |
| get.edge.attribute(g, "weight") | |
| plot(g) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment