Ο Γρίφος του Αινστάιν

Consider the following problem:

  1. there are 5 houses in a line, each with owner, pet, cigarette, drink, color
  2. the englishman lives in the red house
  3. the spaniard owns the dog
  4. coffee is drunk in the green house
  5. the ukrainian drinks tea
  6. the green house is immediately to the left of the ivory house
  7. the winston smoker owns snails
  8. kools are smoked in the yellow house
  9. milk is drunk in the middle house
  10. the norwegian lives in the first house on the left
  11. the chesterfield smoker lives next to the house with the fox
  12. kools are smoked in the house next to the house with the horse
  13. the lucky strike smoker drinks orange juice
  14. the japanese smokes parliaments
  15. the norwegian lives next to the blue house

Who drinks water, and who owns the zebra?

Another solution is posted here:

See also http://rosettacode.org/wiki/Zebra_puzzle and https://www.youtube.com/playlist?list=PLB470B7816A914D87.

suppressPackageStartupMessages(library(plyr))
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(xtable))


h <- 1:5
o <- c("eng","spa","ukr","nor","jap")
p <- c("dog","fox","horse","snails","zebra")
s <- c("winston","kools","chesterfield","strike","parliaments")
d <- c("coffee","tea","milk","juice","water")
r <- c("red","green","ivory","yellow","blue")

dt <- expand.grid(h,o,p,s,d,r)
names(dt) <- c("h","o","p","s","d","r")


dt1 <- dt %>%
  filter(!((o=="eng" & r!="red") | (o!="eng" & r=="red"))) %>%
  filter(!((o=="spa" & p!="dog") | (o!="spa" & p=="dog"))) %>%
  filter(!((d=="coffee" & r!="green") | (d!="coffee" & r=="green"))) %>%
  filter(!((o=="ukr" & d!="tea") | (o!="ukr" & d=="tea"))) %>%
  filter(!((s=="winston" & p!="snails") | (s!="winston" & p=="snails"))) %>%
  filter(!((s=="kools" & r!="yellow") | (s!="kools" & r=="yellow"))) %>%
  filter(!((d=="milk" & h!=3) | (d!="milk" & h==3))) %>%
  filter(!((o=="nor" & h!=1) | (o!="nor" & h==1))) %>%
  filter(!((s=="strike" & d!="juice") | (s!="strike" & d=="juice"))) %>%
  filter(!((o=="jap" & s!="parliaments") | (o!="jap" & s=="parliaments")))

You’ll have to declare some helper functions

to_right_h <- function(x) {
    to_r_h <- x + 1
    return(dplyr::intersect(to_r_h, 1:5))
}

to_left_h <- function(x) {
    to_l_h <- x - 1
    return(dplyr::intersect(to_l_h, 1:5))
}

next_to_h <- function(x) {
    next_h <- unique(c(x - 1, x + 1))
    return(dplyr::intersect(next_h, 1:5))
}

neighbour_elimination <- function(f1, var1, f2, var2, type = "nextto") {
    # if type != 'nextto' thwn var1 is immediately to the left of var2
    
    str1 <- paste0("unique(dt1[dt1$", f1, " == var1, 'h'])")
    var1_h <- eval(parse(text = str1))
    var2_h <- if (type == "nextto") {
        next_to_h(var1_h)
    } else {
        to_right_h(var1_h)
    }
    if (length(var2_h) > 1) {
        str2 <- paste0("dt1 %>% filter(!(", f2, " == var2 & !(h %in% var2_h)))")
        dt1 <<- eval(parse(text = str2))
    } else {
        str2 <- paste0("dt1 %>% filter(!((", f2, " == var2 & h != var2_h) | (", f2, 
            " != var2 & h == var2_h)))")
        dt1 <<- eval(parse(text = str2))
    }
    
    str1 <- paste0("unique(dt1[dt1$", f2, " == var2, 'h'])")
    var2_h <- eval(parse(text = str1))
    var1_h <- if (type == "nextto") {
        next_to_h(var2_h)
    } else {
        to_left_h(var2_h)
    }
    if (length(var1_h) > 1) {
        str2 <- paste0("dt1 %>% filter(!(", f1, " == var1 & !(h %in% var1_h)))")
        dt1 <<- eval(parse(text = str2))
    } else {
        str2 <- paste0("dt1 %>% filter(!((", f1, " == var1 & h != var1_h) | (", f1, 
            " != var1 & h == var1_h)))")
        dt1 <<- eval(parse(text = str2))
    }
}

contradiction_elimination <- function(f) {
    if (nrow(dt1) > length(h)) {
        str1 <- paste0("ddply(dt1, .(", f, "), function(x) apply(x, 2, function(y) length(unique(y))))")
        var_data <- eval(parse(text = str1))
        str1 <- paste0("var_data[, -which(names(dt1)=='", f, "')]")
        var_data <- eval(parse(text = str1))
        var_list <- apply(var_data, 1, function(x) names(which(x == 1)))
        
        for (i in seq(length(var_list))) {
            str2 <- paste0("levels(dt1$", f, ")[i]")
            var_value <- eval(parse(text = str2))
            
            if (!is.null(var_value)) {
                for (j in seq(var_list[[i]])) {
                  # η j ιδιότητα ανήκει σίγουρα στο i, άρα πρέπει να σβήσει από οπουδήποτε αλλού
                  property <- var_list[[i]][j]
                  str3 <- paste0("ifelse(property == 'h', as.numeric(unique(with(dt1,dt1[", 
                    f, " == var_value, property]))), as.character(unique(with(dt1, dt1[", 
                    f, " == var_value, property]))))")
                  property_value <- eval(parse(text = str3))
                  str4 <- ifelse(property == "h", paste0("with(dt1,dt1[!(", f, "!='", 
                    var_value, "' & ", property, "==", property_value, "),])"), paste0("with(dt1,dt1[!(", 
                    f, "!='", var_value, "' & ", property, "=='", property_value, 
                    "'),])"))
                  dt1 <<- eval(parse(text = str4))
                }
            } else {
                # Αυτο σημαινει ότι ο factor f είναι αριθμητική και όχι κατηγορική μεταβλητή
                for (j in seq(var_list[[i]])) {
                  # η j ιδιότητα ανήκει σίγουρα στο σπίτι i, άρα πρέπει να σβήσει από οπουδήποτε
                  # αλλού
                  property <- var_list[[i]][j]
                  str3 <- paste0("as.character(unique(with(dt1, dt1[", f, " == i, property])))")
                  property_value <- eval(parse(text = str3))
                  str4 <- paste0("with(dt1,dt1[!(", f, "!=i & ", property, "=='", 
                    property_value, "'),])")
                  dt1 <<- eval(parse(text = str4))
                }
            }
            
        }
    }
}

Now deal with the rest of the hints.

repeat {
  nrow_dt1_init <- nrow(dt1)
  
  repeat {
    counter <- nrow(dt1)
    
    # 6. the green house is immediately to the left of the ivory house #######
    neighbour_elimination("r","green","r","ivory",type="left") # 
    
    # 11. the chesterfield smoker lives next to the house with the fox #######
    neighbour_elimination("s","chesterfield","p","fox")

    # 12. kools are smoked in the house next to the house with the horse #####
    neighbour_elimination("s","kools","p","horse")

    # 15. the norwegian lives next to the blue house #########################
    neighbour_elimination("o","nor","r","blue")
    
    
    if (nrow(dt1) == counter) 
      break
  }
  
  ################# ELIMINATE CONTRADICTIONS ########################
  
  sapply(c("h","o","p","s","d","r"),contradiction_elimination)
  
  if (nrow(dt1) == nrow_dt1_init) 
    break
}



..and the solution is:

names(dt1) <- c("House No.","Owner","Pet","Smoke","Drink","Color")
print(xtable(dt1, align="ccccccc"), type="html", html.table.attributes='class="table table-striped table-hover center"', include.rownames=FALSE)
House No. Owner Pet Smoke Drink Color
3 eng snails winston milk red
4 jap zebra parliaments coffee green
5 spa dog strike juice ivory
1 nor fox kools water yellow
2 ukr horse chesterfield tea blue