Solve Aristotle's Number Problem

Question

Aristotle's number puzzle is the challenge of populating each of 19 cells in a hexagonal grid with a unique integer between 1 and 19 such that the total along every axis is 38.

You can picture the game board looking like this:

And the puzzle, in essence, is the solution to the following set of fifteen equations:

((a + b + c) == 38 && (d + e + f + g) == 38 && (h + i + j + k + l) == 
   38 && (m + n + o + p) == 38 && (q + r + s) == 38 && (a + d + h) == 
   38 && (b + e + i + m) == 38 && (c + f + j + n + q) == 
   38 && (g + k + o + r) == 38 && (l + p + s) == 38 && (c + g + l) == 
   38 && (b + f + k + p) == 38 && (a + e + j + o + s) == 
   38 && (d + i + n + r) == 38 && (h + m + q) == 38)

Where each variable is a unique number in the set {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19}.

There are multiple possible solutions, and are 19! possible combinations of integers, so naive brute force will be impractical.

Rules:

1. No hardcoding the answer or looking up the answer elsewhere; your code needs to find it on its own
2. Speed doesn't matter, but you do have to show your results, so code that takes 1000 years to run won't help you
3. Find all the answers
4. Treat answers that are identical under rotation as identical
5. Deduct 5% of your total byte count if you output the results in an attractive honeycomb
6. Fewest bytes wins

Answer 1

Haskell 295 289

import Data.List
t=38
y a b=[max(19-b)(a+1)..19]
w=y 0 t
x=filter((==w).sort)$[[a,b,c,d,e,f,g,h,i,t-a-e-o-s,k,l,m,t-d-i-r,o,p,q,r,s]|a<-[1..14],c<-y a a,l<-y a c,s<-y a l,q<-y a s,h<-y c q,e<-w,let{f=t-g-e-d;i=t-b-e-m;o=t-r-k-g;k=t-p-f-b;b=t-a-c;g=t-l-c;p=t-l-s;r=t-q-s;m=t-q-h;d=t-a-h}]

Another similar answer, using arithmetic to get the intermediate hexes. Unlike the other solutions, I don't test for those sums being > 0, testing that the sorted hexes are equal to the range [1..19] is enough. a, c and h are restricted so that only uniquely rotated/mirrored solutions are allowed. The solution appears after a few seconds, then there's a wait of a minute or so while it decides there's no more.

Usage in ghci:

ghci> x
[[3,19,16,17,7,2,12,18,1,5,4,10,11,6,8,13,9,14,15]]

Edited to shave a few chars. 'y 0 t' produces [1..19].

Answer 2

Java (1517 - 75.85) = 1441.15 (1429 - 71.45) = 1357.55 (1325 - 66.25) = 1258.75

This was fun.

Prints all unique solutions w.r.t. mirroring and rotation, in a pleasant honeycomb (hence 5% reduction)

Runtime: ~0.122s (122 milliseconds) on my 4 year old laptop.

Golfed code (edit realized I was stupidly repeating my printfs, reduced them to a single printf for maximum golf) (new edit Reduced calls to Set functions into clever smaller functions, some other micro-optimizations):

import java.util.*;class A{boolean c(Set<Integer>u,int z){return!u.contains(z);}Set<Integer>b(Set<Integer>c,int...v){Set<Integer>q=new HashSet<Integer>(c);for(int x:v)q.add(x);return q;}void w(){Set<Integer>U,t,u,v,w,y,z;int a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,X,Z;X=20;Z=38;for(a=1;a<X;a++)for(b=1;b<X;b++)if(b!=a)for(c=1;c<X;c++)if(c!=a&&c!=b&&a+b+c==Z){U=b(new HashSet<Integer>(),a,b,c);for(d=1;d<X;d++)if(c(U,d))for(h=1;h<X;h++)if(h!=d&&c(U,h)&&a+d+h==Z){t=b(U,a,b,c,d,h);for(m=1;m<X;m++)if(c(t,m))for(q=1;q<X;q++)if(q!=m&&c(t,q)&&h+m+q==Z){u=b(t,m,q);for(r=1;r<X;r++)if(c(u,r))for(s=1;s<X;s++)if(s!=r&&c(u,s)&&q+r+s==Z){v=b(u,r,s);for(p=1;p<X;p++)if(c(v,p))for(l=1;l<X;l++)if(l!=p&&c(v,l)&&s+p+l==Z){w=b(v,p,l);for(g=1;g<X;g++)if(c(w,g)&&l+g+c==Z)for(e=1;e<X;e++)if(e!=g&&c(w,e))for(f=1;f<X;f++)if(f!=e&&f!=g&&c(w,f)&&d+e+f+g==Z){y=b(w,g,e,f);for(i=1;i<X;i++)if(c(y,i))for(n=1;n<X;n++)if(n!=i&&c(y,n)&&d+i+n+r==Z&&b+e+i+m==Z){z=b(y,i,n);for(o=1;o<X;o++)if(c(z,o))for(k=1;k<X;k++)if(k!=o&&c(z,k)&&m+n+o+p==Z&&r+o+k+g==Z&&b+f+k+p==Z)for(j=1;j<X;j++)if(c(z,j)&&j!=o&&j!=k&&a+e+j+o+s==Z&&c+f+j+n+q==Z&&h+i+j+k+l==Z){System.out.printf("%6d%4d%4d\n\n%4d%4d%4d%4d\n\n%2d%4d%4d%4d%4d\n\n%4d%4d%4d%4d\n\n%6d%4d%4d\n\n",a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s);return;}}}}}}}}}public static void main(String[]a){(new A()).w();}}

Brute force is passe, but clever use of the fact that only a very small set of solutions exists led me to an iteration based answer, where within each loop of the iteration I only consider integers that have not been "assigned" yet. I make use of Java's HashSet to gain O(1) lookups for numbers that have been used previously. Finally, there are exactly 12 solutions, but when you discount both rotation and mirroring this reduces to just one unique solution, so when the first solution is encountered, I print it out and terminate. Check out my less-golfed code at github for a bit of a clearer view into how I am approaching this solution.

Enjoy!

Answer 3

C, 366 bytes (C++ 541 450)

#define R(i)for(int i=19;i;--i)
#define X(x)if(x>0&&!V[x]++)
#define K(X)X(a)X(b)X(c)X(d)X(e)X(f)X(g)X(h)X(i)X(j)X(k)X(l)X(m)X(n)X(o)X(p)X(q)X(r)X(s)
Q(x){printf("%d ",x);}
T=38,V[99];main(){R(h)R(c)R(s)R(a)R(l)R(q)R(e){int d=T-a-h,b=T-a-c,g=T-c-l,p=T-l-s,r=T-q-s,m=T-h-q,f=T-g-e-d,i=T-b-e-m,n=T-d-i-r,o=T-p-n-m,k=T-g-o-r,j=T-h-i-k-l;R(C)V[C]=0;K(X)K(+Q),exit(0);}}

Compile with gcc -std=c99 -O3.

Prints all unique solutions modulo rotation and mirroring, in the format a b c d ..., one per line.

Runtime: 0.8 seconds on my computer.

We enumerate the cells in the order h -> c -> s -> a -> l -> q -> e for maximum prunability. In fact the version above just tries every 20^7 assignments for those variables. Then we can compute all the other cells. There is only one unique solution modulo rotation/mirroring. An older, less golfed and ~20 times faster (due to pruning) C++ version can be found on Github

Answer 4

Matlab: 333 320 characters

This is a pretty dumb near-brute-force approach that doesn't use recursion. It builds up partial solutions in z, which is printed out at the end. Each column is a solution; elements are listed a-z from top to bottom. Runtime is 1-2 hours.

z=[];
a='abc adh hmq qrs spl lgc defg beim mnop dinr rokg pkfb hijkl aejos cfjnq';while a[k,a]=strtok(a);n=length(k);x=nchoosek(1:19,n)';s=[];for t=x(:,sum(x)==38)s=[s,perms(t)'];end
m=0.*s;m(19,:)=0;m(k(1:n)-96,:)=s(1:n,:);y=[];for p=m for w=z m=[];l=w.*p~=0;if p(l)==w(l) y(:,end+1)=w+p.*(~l);end
end
end
z=[m,y];end
z

Running from within Matlab:

>> aristotle;
>> z(:,1)

ans =

    9
   11
   18
   14
    6
    1
   17
   15
    8
    5
    7
    3
   13
    4
    2
   19
   10
   12
   16