# http://en.wikipedia.org/wiki/Impossible_Puzzle
#
# Also: The Freudenthal problem
#
# X and Y are two different integers, greater than 1, with sum less than 100. S and P are two mathematicians; S knows the sum X+Y, P knows the product X*Y, and both know the information in these two sentences. The following conversation occurs.
#
# * P says "I cannot find these numbers."
# * S says "I was sure that you could not find them. I cannot find them either."
# * P says "Then, I found these numbers."
# * S says "If you could find them, then I also found them."
# What are these numbers?
##################################################
# FUNCTIONS
##################################################
# Compute the product by row of the N*2 matrix V
rowProd <- function(V) {
return (apply(V, 1, prod))
}
# Round toward 0 (integer part?)
fix <- function(N) {
return (floor(N)+(N<0))
}
# Get all integer factors of the number N
factors <- function(N) {
f = which((N %% (1:floor(sqrt(N)))) == 0)
f = unique(c(1, N, f, fix(N/f)))
return (sort(f))
}
# Get all integer factors of the number N
# Exclude 1 and numbers > sqrt(N)
factorsX <- function(N) {
f = 1+which((N %% (2:floor(sqrt(N)))) == 0)
return (sort(f))
}
# Factorize the number N in a product of two elements
# Exclude 1*N, and any A*B where A>B
factProd <- function(N) {
f = factorsX(N)
return (cbind(f,N/f))
}
# Factorize the number N in a sum of two elements
# Exclude 1+(N-1), and any A+B where A>B
factSum <- function(N) {
v = floor(N/2)
if((N %% 2)==0)
v=v-1
f = NULL
if(v>=2)
f = 2:v
return (cbind(f,N-f))
}
# Return the elements of V appearing more than 1 time
dupl <- function(V) {
return(V[duplicated(V, fromLast=TRUE) | duplicated(V)])
}
# Return the elements of V appearing only 1 time
uniq <- function(V) {
return(V[!(duplicated(V, fromLast=TRUE) | duplicated(V))])
}
# Return true for each duplicated element
isdupl <- function(V) {
return(duplicated(V, fromLast=TRUE) | duplicated(V))
}
# Return true if the vector V is found in a row of M
isfound <- function(M, V) {
return(any(apply(M, 1, function(x, want) all(x==want), V)))
}
# Return true if the number 'product' N is still valid for S:
# - factorization in product (when trivial/duplicated are removed) give at least two answers
# - two of these answers are in M
valid1 <- function(N, M) {
f = factProd(N)
L = dim(f)[1]
if(L<=1) return (FALSE)
n = 0
for(i in 1:L) {
if(isfound(M, f[i,])) {
n = n+1
}
}
if(n<2) return (FALSE)
return (TRUE)
}
# Return true if the number 'sum' N is still valid for S:
# - factorization in sum is in M, at least two times
# - all products of these factorizations passes valid1()
valid1b <- function(N, M) {
f = factSum(N)
L = dim(f)[1]
if(L<=1) return (FALSE)
n = 0
for(i in 1:L) {
if(isfound(M, f[i,])) {
n = n+1
t = valid1(prod(f[i,]), M)
#cat(f[i,], "P", prod(f[i,]), "T", t, "\n")
if(!t)
return (FALSE) # If S is sure, then all products should pass valid1()
}
}
if(n<2) return (FALSE)
return (TRUE)
}
# Return true if the number 'sum' N is still valid for S:
# - at least two solutions in M so that the sum is N
valid2 <- function(N, V, M) {
return(dim(M[V==N,])[1]>1)
}
##################################################
# TESTS
##################################################
a <- c(-1.9, -0.2, 3.4, 5.6, 7.0, 2.4)
#fix(a)
#factors(60)
#factorsX(60)
#factProd(60)
#rowProd(factProd(60))
a <- c(1, 2, 3, 2, 4, 5, 6, 1, 1, 5, 4)
#uniq(a)
#setdiff(unique(a), setdiff(a, unique(a)))
#isdupl(a)
#all(a[isdupl(a)] == dupl(a))
#all(a[!isdupl(a)] == uniq(a))
##################################################
# PROBLEM
##################################################
# Solve the problem for the given parameter
solver <- function(MaxSum) {
M = NULL
# X and Y are two different integers, greater than 1
for(X in 2:(MaxSum-3)) {
for(Y in (X+1):(MaxSum-2)) {
M = rbind(M, c(X,Y))
}
}
cat("Still exiting", dim(M)[1], "solutions\n")
# with sum less than 'MaxSum'
M0 = M[rowSums(M)