Pagini recente » Cod sursa (job #3152259) | Cod sursa (job #256089) | Cod sursa (job #1830353) | Cod sursa (job #1685613) | Cod sursa (job #479875)
Cod sursa(job #479875)
const base = 1000000000 ;
nbase = 9 ;
type vec = string [255] ;
vec1 = array[0 .. 25] of longint ;
var N, j, i, k, l, y : longint ;
v : array[1 .. 100000] of longint ;
f, g : text ;
x : vec ;
procedure fisier;
begin
assign ( f,'sum.in' ) ; reset ( f ) ;
assign ( g,'sum.out') ; rewrite ( g ) ;
end;
procedure atr ( var A : vec1; X : longint ) ; // A <- X
begin
A[0] := 0;
while ( X <> 0 ) do
begin
inc ( A[0] );
A[A[0]] := X mod base;
X := X div base;
end;
end;
procedure mul ( var A : vec1 ; B : longint ) ; // A <- A * B
var i : longint;
t : int64 ;
begin
t := 0; i := 1;
while ( i <= A[0] ) or ( t <> 0 ) do
begin
if ( i > A[0] ) then
A[i] := 0;
t := t + int64 ( A[i] ) * int64 ( B );
A[i] := t mod base;
t := t div base;
inc ( i ) ;
end;
A[0] := i - 1;
end;
procedure scrie ( A : vec1 ) ;
var i, j, p, t : longint;
begin
write ( g, A[A[0]] ) ;
for i := A[0] - 1 downto 1 do
begin
t := 0 ; p := A[i] ;
while ( p <> 0 ) do
begin
p := p div 10 ;
inc ( t ) ;
end ;
for j := 1 to nbase - t do
write ( g, '0' ) ;
if ( A[i] <> 0 ) then
write ( g, A[i] ) ;
end ;
writeln ( g ) ;
end;
function parse ( var x : vec ) : longint ;
var i , y : longint;
begin
i := 1; y := 0;
while ( i <= k ) do
begin
if ( x[i] >= '0' ) and ( x[i] <= '9' ) then
y := y * 10 + ord ( x[i] ) - 48
else
begin
inc ( i ) ;
break;
end;
inc ( i ) ;
end;
parse := y ;
end;
procedure scrie ( k : qword ) ;
var i, nr : longint ;
d : qword ;
st : string[15] ;
c : array[1 .. 15] of byte ;
begin
nr := 0 ;
while ( k > 0 ) do
begin
inc ( nr ) ;
d := k div 10 ;
c[nr] := k - 10 * d + 48 ;
k := d ;
end;
for i := nr downto 1 do
st[nr - i + 1] := chr ( c[i] ) ;
st[0] := chr ( nr ) ;
writeln ( g , st ) ;
end;
procedure ciur;
begin
for i := 1 to 100000 do
v[i] := i ;
i := 2 ;
while ( i <= 50000 ) do
begin
if ( v[i] = i ) then
begin
j := i ;
while j <= 100000 do
begin
v[j] := v[j] div i * ( i - 1 ) ;
j := j + i ;
end;
end;
if ( i = 2 ) then inc ( i, 1 )
else inc ( i, 2 ) ;
end;
end;
procedure citire ;
begin
readln ( f, N ) ;
end ;
procedure main ;
var A : vec1 ;
begin
for i := 1 to N do
begin
read ( f, x ) ; k := length ( x ) ;
y := parse ( x ) ; atr ( A, y ) ;
mul ( A, v[y] * 2 ) ;
scrie ( A ) ;
//scrie ( int64 ( v[y] ) * int64 ( y shl 1 ) ) ;
readln ( f ) ;
end;
end;
//---------------------
begin
fisier ; ciur ; citire ;
main ;
close ( f ) ; close ( g ) ;
end.