Advertisement
algorithmuscanorj

Schoolar farewell task #2

Dec 18th, 2012
412
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 3.90 KB | None | 0 0
  1. program first_half_twelve_factorial_terms_for_a217626;
  2.  
  3. label
  4.   The_end;
  5.  
  6. (*
  7.  
  8. Devised and released for documentation purposes under the terms of use of
  9. "The On-Line Encyclopedia Of Integer Sequences" (OEIS.org).
  10.  
  11. For details please visit: http://www.oeis.org
  12.  
  13.  
  14. Dear user/reader:
  15. -----------------
  16.  
  17. When it is used properly, this code should help you to find the first ( (12!/2)-1 ) terms
  18. of A217626, a task for which you need to have stored at least the first ( (12!/2)+1 ) terms
  19. of A215940.
  20.  
  21. The idea behind this processing was taken from a test session under PARI/GP like:
  22.  
  23. x=[6,0,1,2,3,4,5,7,8,9,10,11];
  24. z=sum(y=1,12,x[y]*12^(12-y));
  25. print(z);
  26.  
  27. This program is not expensive in lines of code and extra details such as tech checkings...
  28. It is assumed here that you know what you are doing when messing with it, for this
  29. subtle reason previously mentioned, this code goes without any warranty whatsoever.
  30.  
  31. *)
  32.  
  33. const
  34.   base=12;
  35.   denominator=base-1; (*Unconditionally should be the quantity (base-1) in decimal*)
  36.   power12: array [1..base] of int64=
  37.   (base*base*base*base*base*base*base*base*base*base*base,
  38.    base*base*base*base*base*base*base*base*base*base,
  39.    base*base*base*base*base*base*base*base*base,
  40.    base*base*base*base*base*base*base*base,
  41.    base*base*base*base*base*base*base,
  42.    base*base*base*base*base*base,
  43.    base*base*base*base*base,
  44.    base*base*base*base,
  45.    base*base*base,
  46.    base*base,
  47.    base,
  48.    1);
  49.    
  50. var
  51. input_f:text;
  52. input_s:string;
  53. delta_A_operand,
  54. delta_B_operand,
  55. delta_quotient,
  56. prev_quotient: int64;
  57. register: array [1..100] of int64;
  58.  
  59. function f(x:char):byte;
  60. var
  61.   ans:byte;
  62. begin
  63.   if (x in ['a'..'z']) then begin
  64.     ans:=10+ord(x)-ord('a');
  65.   end else if (x in ['0'..'9']) then begin
  66.     ans:=ord(x)-ord('0');
  67.   end else begin
  68.     ans:= 255;
  69.   end;
  70.   f:=ans;
  71. end;
  72.  
  73. function g(y:string):int64;
  74. var
  75.   ans:int64;
  76.   k:byte;
  77. begin
  78.   ans:=0;
  79.   if (length(y) = base) then for k:= 1 to base do begin
  80.     ans:= ans + f(y[k])*power12[k];
  81.   end;
  82.   g:=ans;
  83. end;
  84.  
  85. function p(q:longint):longint;
  86. var
  87.   ans,
  88.   u:longint;
  89. begin
  90.   ans:=1;
  91.   if (q >= 1) then begin
  92.      for u:= 1 to q do begin
  93.     ans:= ans*10;
  94.      end;
  95.   end;
  96.   p:=ans;
  97. end;
  98.  
  99. function h(b:longint; z:int64):int64;
  100. var
  101.   ans,
  102.   cz:int64;
  103.   k,
  104.   w:longint;
  105. begin
  106.   ans:=0;
  107.   cz:=z;
  108.   k:=1;
  109.   while (cz >= b) do begin
  110.     register[k]:= cz mod b;
  111.     cz:= cz div b;
  112.     k:=k+1;
  113.   end;
  114.   register[k]:=cz;
  115.   for w:= k downto 1 do begin
  116.     ans:= ans+register[w]*p(w-1);
  117.   end;
  118.   h:=ans;
  119. end;
  120.  
  121. (*
  122.     The filename of the data intended to be processed here should be
  123.     passed as the first and unique parameter in the command line
  124.     invocation to this program. The output is made directly to the
  125.     console, so normally you should redirect it to a file in order
  126.     to save the answer (Just a term of A217626 in each line, like
  127.     in a b-file but without including the offsets at left)
  128. *)
  129.  
  130. begin
  131.   if (paramcount() = 1) then begin
  132.     assign(input_f, paramstr(1));
  133.     (*$i-*)reset(input_f);(*$i+*)
  134.     if (IOResult = 0) then begin
  135.       readln(input_f, input_s);
  136.       delta_A_operand:= g(input_s);
  137.       (*
  138.       writeln('0');
  139.       *)
  140.       prev_quotient:= 0;
  141.       while (not eof(input_f)) do begin
  142.     readln(input_f,input_s);
  143.     delta_B_operand:= g(input_s);
  144.     delta_quotient:=h(base,(delta_B_operand - delta_A_operand) div denominator);
  145.     writeln(delta_quotient-prev_quotient);
  146.     (* Toggle the following comment switch in order to obtain either A215940 (OFF) or A217626 (ON). Default is OFF; *)
  147.     (**)
  148.     prev_quotient:= delta_quotient;
  149.     (**)
  150.       end;
  151.     end else begin
  152.       writeln('Unexpected error when processing: ',paramstr(1),'; **ABORTING**');
  153.       goto The_end;
  154.     end;
  155.     close(input_f);
  156.   end else begin
  157.     writeln('You must specify one and only one filename as invocation parameter. Please try again.');
  158.   end;
  159.   The_end:
  160. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement