Recent

Author Topic: Contest: fastest program to solve a christmas puzzle  (Read 24310 times)

Blaazen

  • Hero Member
  • *****
  • Posts: 3237
  • POKE 54296,15
    • Eye-Candy Controls
Re: Contest: fastest program to solve a christmas puzzle
« Reply #15 on: December 19, 2018, 05:05:15 pm »
I attach my second version, where is one optimalization. In this puzzle really does not matter on the K, so I omitted it from loops. Now it is ~100 ticks instead of ~270 with the same output. Still far from engkin's solution although.  :(

Code: Pascal  [Select][+][-]
  1. program project1;
  2. {$R *.res}
  3.  
  4. uses {$IFDEF UNIX} cthreads, {$ENDIF} SysUtils, Math;
  5.  
  6. var
  7.   Used: array[0..9] of Boolean;
  8.   Res: array[0..7] of Integer;
  9.   REKENLES: array[0..1] of Integer;
  10.   ResIndex: SmallInt;
  11.  
  12.   procedure Output;
  13.   var i, j, k: Integer;
  14.   begin  { KERST = REKENEN + MET * TIEN - LETTERS }
  15.     for i:=0 to 7 do
  16.       if not Used[i] then
  17.         begin
  18.           k:=i;
  19.           REKENLES[ResIndex]:=
  20.             10000000*Res[5]+1000000*Res[0]+100000*k+10000*Res[0]+
  21.             1000*Res[4]+100*Res[2]+10*Res[0]+Res[6];
  22.           write(  'K=', k);
  23.           write(', E=', Res[0]);
  24.           write(', R=', Res[5]);
  25.           write(', S=', Res[6]);
  26.           write(', T=', Res[7]);
  27.           write(', N=', Res[4]);
  28.           write(', M=', Res[3]);
  29.           write(', I=', Res[1]);
  30.           write(', L=', Res[2]);
  31.           write('  MINSTREEL=', Res[3], Res[1], Res[4], Res[6], Res[7],
  32.             Res[6], Res[0], Res[0], Res[2],', ');
  33.           writeln('REKENLES=', Res[5], Res[0], k, Res[0], Res[4], Res[2],
  34.             Res[0], Res[6]);
  35.           inc(ResIndex);
  36.         end;
  37.   end;
  38.  
  39.   procedure Variace(j: Byte);
  40.   var i, krl, m, ti: Integer;
  41.   begin
  42.     if j<=7 then
  43.       begin
  44.         for i:=0 to 9 do
  45.           if not Used[i] then
  46.             begin
  47.               Res[j]:=i;
  48.               Used[i]:=True;
  49.               Variace(j+1);
  50.               Used[i]:=False;
  51.             end;
  52.       end else
  53.       begin
  54.         krl:=1000000*(Res[5]-Res[2])-11000*Res[7]+100*(Res[4]-Res[0]-Res[5])
  55.           +10*(Res[0]-Res[5]-Res[6])+Res[4]-Res[6]-Res[7];
  56.         m:=100*Res[3]+10*Res[0]+Res[7];
  57.         ti:=1000*Res[7]+100*Res[1]+10*Res[0]+Res[4];
  58.         if (krl+m*ti)=0 then Output;
  59.       end;
  60.   end;
  61.  
  62. var i, j: Integer;
  63.     q: QWord;
  64. begin
  65.   q:=GetTickCount64;
  66.   ResIndex:=0;
  67.   for i:=0 to 8 do
  68.     Used[i]:=False;
  69.   Variace(0);
  70.   writeln(REKENLES[0], ' * ', REKENLES[1], ' = ', REKENLES[0]*REKENLES[1]);
  71.   writeln('q: ', GetTickCount64-q);
  72. end.
Lazarus 2.3.0 (rev main-2_3-2863...) FPC 3.3.1 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

damieiro

  • Full Member
  • ***
  • Posts: 200
Re: Contest: fastest program to solve a christmas puzzle
« Reply #16 on: December 19, 2018, 06:22:55 pm »
Brute force only or is allowed analitics?

Because if one starts analizing like engkin (good eye ;) ), some values can be known :P

If i did correctly the math (at daring glaze) the expresion is like this

1000000*(R-L)+100000*MT+10000*(MI+ET-T)+1000*(ME+EI+TT-T)+100*(2N+IT+EE-E-R)+10*(E-R+EN+ET-S)+N-S+NT-T=0;
« Last Edit: December 19, 2018, 06:48:48 pm by damieiro »

User137

  • Hero Member
  • *****
  • Posts: 1791
    • Nxpascal home
Re: Contest: fastest program to solve a christmas puzzle
« Reply #17 on: December 19, 2018, 08:10:57 pm »
My solution was quite different from the others, i guess just less optimal brute force. But i don't calculate the whole formula on every iteration, only when the character in that word changes and only the last change. It's using 10 threads.

edit: It came to my attention that last multiplication needs to be typed to int64. It wasn't a problem for me with 64-bit compiler where integer is 64-bit.
« Last Edit: December 19, 2018, 11:00:50 pm by User137 »

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: Contest: fastest program to solve a christmas puzzle
« Reply #18 on: December 19, 2018, 09:45:28 pm »
I forgot to say that when I read:
..
And the code to display the product of the 2 values for REKENLES should be (executed only once):
..
?? * ?? = 1196530768447364
I knew that S either has one value 2 (2*2=4), or two possible values 1 and 4 (1*4=4). But we were not supposed to use this information to find the solution.

Blaazen

  • Hero Member
  • *****
  • Posts: 3237
  • POKE 54296,15
    • Eye-Candy Controls
Re: Contest: fastest program to solve a christmas puzzle
« Reply #19 on: December 19, 2018, 09:55:00 pm »
Similar with "K". The only two occurences of "K" in formula are KERST = REKENEN+... on the position 10000, therefore it does not depend on value of "K" . I used this info for optimalization of the second version.
Lazarus 2.3.0 (rev main-2_3-2863...) FPC 3.3.1 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Contest: fastest program to solve a christmas puzzle
« Reply #20 on: December 19, 2018, 10:55:18 pm »

KERST = REKENEN + MET * TIEN - LETTERS
or
KERST + LETTERS = REKENEN + MET * TIEN
or
Ones digit (KERST + LETTERS) = Ones digit (REKENEN + MET * TIEN)
or
(KERST + LETTERS) mod 10 = (REKENEN + MET * TIEN) mod 10
or
(T+S) mod 10 = (N+T*N) mod 10

Means I don't have to loop through all variables. I can start with T, S and N:

Clever thinking!

Bart

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Contest: fastest program to solve a christmas puzzle
« Reply #21 on: December 19, 2018, 11:01:36 pm »
Brute force only or is allowed analitics?

You need to eliminate as much permutations beforehand as possible.

While not absolutely certain, from the way the puzzle is written, one could infer that the starting letters of the given words will probably NOT be zero.

Just applying that halved my calculation time.

Bart

avk

  • Hero Member
  • *****
  • Posts: 752
Re: Contest: fastest program to solve a christmas puzzle
« Reply #22 on: December 20, 2018, 10:58:40 am »
if it's not too late, then here is my solution:
Code: Pascal  [Select][+][-]
  1. program pazzle;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. type
  9.   TPermState = record
  10.     case Boolean of
  11.     False: (Dw: DWord);
  12.     True:  (Bits: bitpacked array[0..9] of Boolean);
  13.   end;
  14.  
  15. procedure Solve;
  16. var
  17.   State: TPermState;
  18.   E, I, K, L, M, N, R, S, T, Count: Integer;
  19.   function IsSolution: Boolean;
  20.   begin
  21.     Result := (N + E * 10 + N * 100 + E * 1000 + K * 10000 + E * 100000 + R * 1000000) +
  22.               (T + E * 10 + M * 100) * (N + E * 10 + I * 100 + T * 1000) -
  23.               (S + R * 10 + E * 100 + T * 1000 + T * 10000 + E * 100000 + L * 1000000) =
  24.                T + S * 10 + R * 100 + E * 1000 + K * 10000;
  25.   end;
  26.   function CalcREKENLES: Int64;
  27.   begin
  28.     Result := Int64(S) + Int64(E) * 10 + Int64(L) * 100 + Int64(N) * 1000 + Int64(E) * 10000 +
  29.               Int64(K) * 100000 + Int64(E) * 1000000 + Int64(R) * 10000000;
  30.   end;
  31. var
  32.   REKENLES1, REKENLES2: Int64;
  33. begin
  34.   State.Dw := 1023;
  35.   Count := 0;
  36.   REKENLES1 := 0;
  37.   REKENLES2 := 0;
  38.   for N := 0 to 9 do
  39.     begin
  40.       State.Bits[N] := False;
  41.       for S := 0 to 9 do
  42.         if State.Bits[S] then
  43.           begin
  44.             State.Bits[S] := False;
  45.             for T := 0 to 9 do
  46.               if State.Bits[T] then
  47.                 begin
  48.                   if (10 - S + N * Succ(T)) mod 10 <> T then
  49.                     continue;
  50.                   State.Bits[T] := False;
  51.                   for E := 0 to 9 do
  52.                     if State.Bits[E] then
  53.                       begin
  54.                         State.Bits[E] := False;
  55.                         for I := 0 to 9 do
  56.                           if State.Bits[I] then
  57.                             begin
  58.                               State.Bits[I] := False;
  59.                               for K := 0 to 9 do
  60.                                 if State.Bits[K] then
  61.                                   begin
  62.                                     State.Bits[K] := False;
  63.                                     for L := 0 to 9 do
  64.                                       if State.Bits[L] then
  65.                                         begin
  66.                                           State.Bits[L] := False;
  67.                                           for M := 0 to 9 do
  68.                                             if State.Bits[M] then
  69.                                               begin
  70.                                                 State.Bits[M] := False;
  71.                                                 for R := 0 to 9 do
  72.                                                   if State.Bits[R] then
  73.                                                     if IsSolution then
  74.                                                       begin
  75.                                                         Inc(Count);
  76.                                                         Write('K=',K);
  77.                                                         Write(', E=',E);
  78.                                                         Write(', R=',R);
  79.                                                         Write(', S=',S);
  80.                                                         Write(', T=',T);
  81.                                                         Write(', N=',N);
  82.                                                         Write(', M=',M);
  83.                                                         Write(', I=',I);
  84.                                                         Write(', L=',L);
  85.                                                         Write('  MINSTREEL=',M,I,N,S,T,R,E,E,L,', ');
  86.                                                         WriteLn('REKENLES=',R,E,K,E,N,L,E,S);
  87.                                                         if Count = 1 then
  88.                                                           REKENLES1 := CalcREKENLES;
  89.                                                         if Count = 2 then
  90.                                                           begin
  91.                                                             REKENLES2 := CalcREKENLES;
  92.                                                             WriteLn(REKENLES1,' * ', REKENLES2,' = ',
  93.                                                                     REKENLES1 * REKENLES2);
  94.                                                             exit;
  95.                                                           end;
  96.                                                       end;
  97.                                                 State.Bits[M] := True;
  98.                                               end;
  99.                                           State.Bits[L] := True;
  100.                                         end;
  101.                                     State.Bits[K] := True;
  102.                                   end;
  103.                               State.Bits[I] := True;
  104.                             end;
  105.                         State.Bits[E] := True;
  106.                       end;
  107.                   State.Bits[T] := True;
  108.                 end;
  109.             State.Bits[S] := True;
  110.           end;
  111.       State.Bits[N] := True;
  112.     end;
  113. end;
  114.  
  115. var
  116.   Ticks: QWord;
  117.  
  118. begin
  119.   Ticks := GetTickCount64;
  120.   Solve;
  121.   Ticks := GetTickCount64 - Ticks;
  122.   WriteLn('tick count = ', Ticks);
  123.   ReadLn;
  124. end.
  125.  

Thaddy

  • Hero Member
  • *****
  • Posts: 14204
  • Probably until I exterminate Putin.
Re: Contest: fastest program to solve a christmas puzzle
« Reply #23 on: December 20, 2018, 11:00:12 am »
I wonder if it would be faster to handle the state bits as a set. with include/exclude. Set operations are notoriously fast. Faster than array access?
« Last Edit: December 20, 2018, 11:01:49 am by Thaddy »
Specialize a type, not a var.

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Contest: fastest program to solve a christmas puzzle
« Reply #24 on: December 20, 2018, 02:55:33 pm »
if it's not too late, then here is my solution:

It's not too late.
I'll test at home when I have time.

Bart

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: Contest: fastest program to solve a christmas puzzle
« Reply #25 on: December 20, 2018, 08:24:28 pm »
I think I have another solution.

Thaddy

  • Hero Member
  • *****
  • Posts: 14204
  • Probably until I exterminate Putin.
Re: Contest: fastest program to solve a christmas puzzle
« Reply #26 on: December 20, 2018, 09:45:33 pm »
Let me guess.. :D
Specialize a type, not a var.

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Contest: fastest program to solve a christmas puzzle
« Reply #27 on: December 20, 2018, 10:39:55 pm »
Final entries at december 26th 23:59 CET...

Bart

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: Contest: fastest program to solve a christmas puzzle
« Reply #28 on: December 20, 2018, 10:51:44 pm »

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Contest: fastest program to solve a christmas puzzle
« Reply #29 on: December 20, 2018, 11:02:27 pm »
For fast solutions that need multiple cycles to even be able to get some kind of acurate tick count, I'll measure those with all writing to console commented out.

@engkin: you've got an even faster solution????

Bart

 

TinyPortal © 2005-2018