Recent

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

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Contest: fastest program to solve a christmas puzzle
« on: December 18, 2018, 11:00:30 pm »
Hi,

Here's the puzzle (translated from Dutch):

Given that:
 KERST = REKENEN + MET * TIEN - LETTERS
 Each letter represents a single unique digit (0..9)

- What is the value of MINSTREEL
- REKENLES can be 2 different numbers: what is the product of these two? 

(The first sentence translates to: Christmas = Calculating + With * Ten - Characters)

Can you come up with the fastest algorithm to solve this problem?

Rules:
  • You can use the following standard libraries:
    • SysUtils
    • Math
    • Standard library used to enable threads on your current OS
  • You may also use any library you want to visually enhance your program if you wish to do so.
  • The program must be cross-platform and compilable with fpc 3.0.4. I must be able to test the program on my Win10 machine.
  • The use of (inline) assembly is not allowed.
  • The use of compiler directives other than {$mode }, {$H} or conditional defines to use standard threading libraries is not allowed.
The code displaying the result should  be (expected to be executed twice):
Code: Pascal  [Select][+][-]
  1.   write('K=',K);
  2.   write(', E=',E);
  3.   write(', R=',R);
  4.   write(', S=',S);
  5.   write(', T=',T);
  6.   write(', N=',N);
  7.   write(', M=',M);
  8.   write(', I=',I);
  9.   write(', L=',L);
  10.   write('  MINSTREEL=',M,I,N,S,T,R,E,E,L,', ');
  11.   writeln('REKENLES=',R,E,K,E,N,L,E,S);

And the code to display the product of the 2 values for REKENLES should be (executed only once):
Code: Pascal  [Select][+][-]
  1.   writeln(VarForFirst_REKENLES,' * ',VarForSecond_REKENLES,' = ',YourValueForTheProduct);

Reason: the displaying is part of the timing.



As a proof that I have actually solved this puzzle I give you the expected output for the final calculation:
Code: [Select]
?? * ?? = 1196530768447364


My current solution uses 203 ticks (measured with GetTickCount from start of program to writing down the last calculation).
Speed comparison will be done on my machine, with the exact same compiler options for each program
(this happens to be: -MObjFPC -Scghi -O3 -OoREGVAR -Xs -XX -l -vewnhibq -Filib\i386-win32 -Fu. -FUlib\i386-win32 -FE.), using fpc 3.0.4 32-bit on Win10-64.

Trying several approaches I found that elegant code is not necessarily faster than ugly, seemingly clumsy, code.

Note: a program simply outputting the correct results (after another program calculated it) will not do.
The algorithm for solving the puzzle must be a part of the program (and this part must executed).

I'll keep track of the 5 fastest solutions here.
Ticks are in GetTickCount units.
Note: very fast algorithms are timed over 1000 or 10000 iterations. In that case all writing to console is commented out.

Scores (2018-12-21 19:00 CET):
  • Martin_fr: 0.0006 ticks (a whooping 573000 times faster than my original code)
  • Avk (avk's third entry): 0.0014 ticks
  • Engkin: 0.5342 ticks
  • Blaazen (second entry): 38 ticks
  • User137: 159 ticks

Prizes:
The first and only price will be: eternal fame.
As I am not supposed (nor expected) to win: please beat me...

Eternal fame goes to Martin_fr!

(No more submissions are excepted for the contest as of 20018-12-26 23:59 CET.)

Bart
« Last Edit: December 27, 2018, 06:22:26 pm by Bart »

Blaazen

  • Hero Member
  • *****
  • Posts: 3237
  • POKE 54296,15
    • Eye-Candy Controls
Re: Contest: fastest program to solve a christmas puzzle
« Reply #1 on: December 19, 2018, 02:41:09 am »
I got solution. 640 ticks on my old Core2Duo at 2GHz, single thread, no optimizations. I'll try harder tomorrow.

EDIT: I'm on 270 ticks, with ± your settings, still single thread. What CPU do you have?
« Last Edit: December 19, 2018, 03:14:20 am by Blaazen »
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/

User137

  • Hero Member
  • *****
  • Posts: 1791
    • Nxpascal home
Re: Contest: fastest program to solve a christmas puzzle
« Reply #2 on: December 19, 2018, 03:42:18 am »
We can use TMemo from Lazarus to display results? I'm not fond of console apps.

No algorithm yet but:
Code: Pascal  [Select][+][-]
  1.   timing:=gettickcount64;
  2.  
  3.   memo1.Lines.BeginUpdate;
  4.   memo1.Lines.Add(... the result lines...
  5.  
  6.   timing:=gettickcount64-timing;
  7.   memo1.Lines.Add(format('Elapsed time: %d',[timing]));
  8.   memo1.Lines.EndUpdate;
Sometimes 0 ms, sometimes 15 or 16. Just so you know it's a bit inaccurate.
edit: Begin and EndUpdate helps, it's now always 0 ms with just the displaying.

You never said if combined number can start with 0? I assume not. For example MET with M=0, E=1, T=2 would be 012 or 12. If all numbers are 0's it would be a valid result, making the multiplication of both results 0.
« Last Edit: December 19, 2018, 04:54:54 am by User137 »

Blaazen

  • Hero Member
  • *****
  • Posts: 3237
  • POKE 54296,15
    • Eye-Candy Controls
Re: Contest: fastest program to solve a christmas puzzle
« Reply #3 on: December 19, 2018, 05:04:07 am »
All numbers can't be 0. Mathematically, this puzzle is: http://www.emathematics.net/combinavordinarias.php
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/

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: Contest: fastest program to solve a christmas puzzle
« Reply #4 on: December 19, 2018, 05:31:36 am »
Around 100 ticks here.

Edit:
GetTickCount is not fast enough anymore here. I am getting 0 ticks.
« Last Edit: December 19, 2018, 06:37:23 am by engkin »

User137

  • Hero Member
  • *****
  • Posts: 1791
    • Nxpascal home
Re: Contest: fastest program to solve a christmas puzzle
« Reply #5 on: December 19, 2018, 06:19:55 am »
Solutions found, 594 563 ticks best so far (no optimization).
Actually that's 359 ticks with -O3 and single thread.
110 ticks after multithreading done.

Using Core i5 6400 2.7GHz quadcore.
« Last Edit: December 19, 2018, 07:25:38 am by User137 »

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Contest: fastest program to solve a christmas puzzle
« Reply #6 on: December 19, 2018, 09:45:41 am »
I got solution. 640 ticks on my old Core2Duo at 2GHz, single thread, no optimizations. I'll try harder tomorrow.

EDIT: I'm on 270 ticks, with ± your settings, still single thread. What CPU do you have?

Just PM your solution (if you want it to be secret), or post is here, and I'll compare it to mine.
Ticks on your machine will probably be very different on mine.

I have an Intel Core i5-7200 CPU@2.5 GHz and 8GB of RAM.

Bart

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Contest: fastest program to solve a christmas puzzle
« Reply #7 on: December 19, 2018, 09:49:23 am »
We can use TMemo from Lazarus to display results? I'm not fond of console apps.

Yes, you can.
It will be slower though (the displaying is inside the timing period).

Console apps are not more difficult than GUI apps.
Use Lazarus to create them, so you have all the goodies of CodeTools available.

You never said if combined number can start with 0? I assume not. For example MET with M=0, E=1, T=2 would be 012 or 12.

Starting with 0 is allowed.

If all numbers are 0's it would be a valid result, making the multiplication of both results 0.

Read the puzzle. Each letter identifies a unique single digit.

Bart

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Contest: fastest program to solve a christmas puzzle
« Reply #8 on: December 19, 2018, 09:52:25 am »
GetTickCount is not fast enough anymore here. I am getting 0 ticks.

Wow!
I'ld love to see that code.

OK, when we get in the range of ticks < 10: repeat the entire solution 1000 times and then divide ticks by 1000 (so you can have fractional ticks).

Bart

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Contest: fastest program to solve a christmas puzzle
« Reply #9 on: December 19, 2018, 09:59:10 am »
All numbers can't be 0. Mathematically, this puzzle is: http://www.emathematics.net/combinavordinarias.php

Since (n-m) equals 1, the total will be 10!.
But do you really need to investigate all possible combinations?
I was able to half my time simply by not investigating combinations I could reason to be wrong in the first place.

Bart

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: Contest: fastest program to solve a christmas puzzle
« Reply #10 on: December 19, 2018, 01:47:08 pm »
OK, when we get in the range of ticks < 10: repeat the entire solution 1000 times and then divide ticks by 1000 (so you can have fractional ticks).

2~3 ticks if I switch manually (ALT+TAB) back to the IDE and wait for the CPU activity to go down to avoid scrolling the console penalty. Otherwise, it is ~ 13 ticks.

Edit:
As for the solution, nothing fancy.

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:
Code: Pascal  [Select][+][-]
  1.   for N :=0 to 9 do
  2.     for S := 0 to 9 do
  3.     begin
  4.       if S = N then continue;
  5.       for T := 0 to 9 do
  6.       begin
  7.         if (T = N) or (T = S) then continue;
  8.         if (T+S) mod 10 = (N+T*N) mod 10 then
  9.         begin
  10.  

Only then I need to loop through the rest. The whole code:
Code: Pascal  [Select][+][-]
  1. program puz;
  2.  
  3. {$mode objfpc}{$H-}
  4.  
  5. uses
  6.   {$IFDEF UNIX}{$IFDEF UseCThreads}
  7.   cthreads,
  8.   {$ENDIF}{$ENDIF}
  9.   Classes, sysutils
  10.   { you can add units after this };
  11.  
  12. var
  13.   K,E,R,S,T,N,M,I,L: integer;
  14.   VarForFirst_REKENLES, VarForSecond_REKENLES: Integer;
  15.   YourValueForTheProduct: int64;
  16.   first: boolean = true;
  17.  
  18. function Check(): boolean;
  19. var
  20.   KERST, REKENEN , MET , TIEN , LETTERS: Integer;
  21.   REKEN: Integer;
  22. begin
  23.   KERST   := K*10000+E*1000+R*100+S*10+T ;
  24.   REKEN   := R*1000000+E*100000+K*10000+E*1000+N*100;
  25.   //REKENEN := R*1000000+E*100000+K*10000+E*1000+N*100+E*10+N ;
  26.   REKENEN := REKEN+E*10+N;
  27.   MET     := M*100+E*10+T ;
  28.   TIEN    := T*1000+I*100+E*10+N ;
  29.   LETTERS := L*1000000+E*100000+T*10000+T*1000+E*100+R*10+S ;
  30.  
  31.   Result  := KERST = REKENEN + MET * TIEN - LETTERS;
  32.   //Result  := KERST + LETTERS = REKENEN + MET * TIEN;
  33.  
  34.   if Result then
  35.   begin
  36.     if first then
  37.     begin
  38.       WriteLn('1-REKEN: ',REKEN);
  39.       VarForFirst_REKENLES := REKEN*10+L*100+E*10+S;
  40.       first:= false;
  41.     end
  42.     else
  43.     begin
  44.       WriteLn('2-REKEN: ',REKEN);
  45.       VarForSecond_REKENLES := REKEN*10+L*100+E*10+S;
  46.     end;
  47.   end;
  48. end;
  49.  
  50. var
  51.   counter: integer;
  52.   ticks: Int64;
  53.   rpt: integer;
  54.  
  55. label
  56.   OutOfLoops;
  57.  
  58. begin
  59.   //KERST = REKENEN + MET * TIEN - LETTERS
  60.   //KERST + LETTERS = REKENEN + MET * TIEN
  61.   //U(T+S) = U(N+T*N);
  62.  
  63.   ticks := GetTickCount;
  64.   for rpt := 1 to 1000 do begin
  65.   counter := 0;
  66.  
  67.   for N :=0 to 9 do
  68.     for S := 0 to 9 do
  69.     begin
  70.       if S = N then continue;
  71.       for T := 0 to 9 do
  72.       begin
  73.         if (T = N) or (T = S) then continue;
  74.         if (T+S) mod 10 = (N+T*N) mod 10 then
  75.         begin
  76.           for K := 0 to 9 do
  77.           begin
  78.             if (K=T) or (K=S) or (K=N) then continue;
  79.             for E := 0 to 9 do
  80.             begin
  81.               if (E=T) or (E=S) or (E=N) or (E=K) then continue;
  82.               for R := 0 to 9 do
  83.               begin
  84.                 if (R=T) or (R=S) or (R=N) or (R=K) or (R=E) then continue;
  85.                 for M := 0 to 9 do
  86.                 begin
  87.                   if (M=T) or (M=S) or (M=N) or (M=K) or (M=E) or (M=R) then continue;
  88.                   for I := 0 to 9 do
  89.                   begin
  90.                     if (I=T) or (I=S) or (I=N) or (I=K) or (I=E) or (I=R) or (I=M) then continue;
  91.                     for L := 0 to 9 do
  92.                     begin
  93.                       if (L=T) or (L=S) or (L=N) or (L=K) or (L=E) or (L=R) or (L=M) or (L=I) then continue;
  94.                       if Check() then
  95.                       begin
  96.                         inc(counter);
  97.                         write(' K=',K);
  98.                         write(', E=',E);
  99.                         write(', R=',R);
  100.                         write(', S=',S);
  101.                         write(', T=',T);
  102.                         write(', N=',N);
  103.                         write(', M=',M);
  104.                         write(', I=',I);
  105.                         write(', L=',L);
  106.                         write('  MINSTREEL=',M,I,N,S,T,R,E,E,L,', ');
  107.                         writeln('REKENLES=',R,E,K,E,N,L,E,S);
  108.                         if counter=2 then goto OutOfLoops;
  109.                       end;
  110.  
  111.                     end;
  112.                   end;
  113.                 end;
  114.               end;
  115.             end;
  116.           end;
  117.         end;
  118.       end;
  119.     end;
  120.  
  121. OutOfLoops:
  122.  
  123.   YourValueForTheProduct := int64(VarForFirst_REKENLES)*int64(VarForSecond_REKENLES);
  124.   writeln(VarForFirst_REKENLES,' * ',VarForSecond_REKENLES,' = ',YourValueForTheProduct);
  125.   end;
  126.  
  127.   WriteLn('Ticks: ',(GetTickCount-ticks) div 1000);
  128. end.
« Last Edit: December 19, 2018, 02:15:50 pm by engkin »

Martin_fr

  • Administrator
  • Hero Member
  • *
  • Posts: 9791
  • Debugger - SynEdit - and more
    • wiki
Re: Contest: fastest program to solve a christmas puzzle
« Reply #11 on: December 19, 2018, 02:16:11 pm »
that needs to define, if the writeln in each repeat are measured...

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: Contest: fastest program to solve a christmas puzzle
« Reply #12 on: December 19, 2018, 02:50:35 pm »
The switch is only of the 1000 times

Blaazen

  • Hero Member
  • *****
  • Posts: 3237
  • POKE 54296,15
    • Eye-Candy Controls
Re: Contest: fastest program to solve a christmas puzzle
« Reply #13 on: December 19, 2018, 03:00:41 pm »
Of some reason, when I used two threads it was even slower, so here my single thread solution. Classic approach, I go thru all possible variations.
The ony optimalization is in computing "klr:=.."  (line 48), like REKENEN-LETTERS, where E at position 100000 doesn't need to be computed etc.

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..8] of Integer;  {e i k l m n r s t}
  9.   REKENLES: array[0..1] of Integer;
  10.   ResIndex: SmallInt;
  11.  
  12.   procedure Output;
  13.   begin  { KERST = REKENEN + MET * TIEN - LETTERS }
  14.     REKENLES[ResIndex]:=
  15.       10000000*Res[6]+1000000*Res[0]+100000*Res[2]+10000*Res[0]+
  16.       1000*Res[5]+100*Res[3]+10*Res[0]+Res[7];
  17.     write(  'K=', Res[2]);
  18.     write(', E=', Res[0]);
  19.     write(', R=', Res[6]);
  20.     write(', S=', Res[7]);
  21.     write(', T=', Res[8]);
  22.     write(', N=', Res[5]);
  23.     write(', M=', Res[4]);
  24.     write(', I=', Res[1]);
  25.     write(', L=', Res[3]);
  26.     write('  MINSTREEL=', Res[4], Res[1], Res[5], Res[7], Res[8],
  27.       Res[6], Res[0], Res[0], Res[3],', ');
  28.     writeln('REKENLES=', Res[6], Res[0], Res[2], Res[0], Res[5], Res[3],
  29.       Res[0], Res[7]);
  30.     inc(ResIndex);
  31.   end;
  32.  
  33.   procedure Variace(j: Byte);
  34.   var i, krl, m, ti: Integer;
  35.   begin
  36.     if j<=8 then
  37.       begin
  38.         for i:=0 to 9 do
  39.           if not Used[i] then
  40.             begin
  41.               Res[j]:=i;
  42.               Used[i]:=True;
  43.               Variace(j+1);
  44.               Used[i]:=False;
  45.             end;
  46.       end else
  47.       begin
  48.         krl:=1000000*(Res[6]-Res[3])-11000*Res[8]+100*(Res[5]-Res[0]-Res[6])
  49.           +10*(Res[0]-Res[6]-Res[7])+Res[5]-Res[7]-Res[8];
  50.         m:=100*Res[4]+10*Res[0]+Res[8];
  51.         ti:=1000*Res[8]+100*Res[1]+10*Res[0]+Res[5];
  52.         if (krl+m*ti)=0 then Output;
  53.       end;
  54.   end;
  55.  
  56. var i, j: Integer;
  57.     q: QWord;
  58. begin
  59.   q:=GetTickCount64;
  60.   ResIndex:=0;
  61.   for i:=0 to 9 do
  62.     Used[i]:=False;
  63.   Variace(0);
  64.   writeln(REKENLES[0], ' * ', REKENLES[1], ' = ', REKENLES[0]*REKENLES[1]);
  65.   writeln('q: ', GetTickCount64-q);
  66. end.
  67.  
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/

VTwin

  • Hero Member
  • *****
  • Posts: 1215
  • Former Turbo Pascal 3 user
Re: Contest: fastest program to solve a christmas puzzle
« Reply #14 on: December 19, 2018, 04:22:58 pm »
As for the solution, nothing fancy.

Nice!  :)
“Talk is cheap. Show me the code.” -Linus Torvalds

Free Pascal Compiler 3.2.2
macOS 12.1: Lazarus 2.2.6 (64 bit Cocoa M1)
Ubuntu 18.04.3: Lazarus 2.2.6 (64 bit on VBox)
Windows 7 Pro SP1: Lazarus 2.2.6 (64 bit on VBox)

 

TinyPortal © 2005-2018