LASCALE - Quả Cân
Tác giả: ladpro98
Ngôn ngữ: Pascal
program lascale;
uses math;
const fi='';
var f,left,right:array[1..50] of longint;
lt:array[0..50] of longint;
n,d:longint;
sl,sr,sn:string;
procedure input;
var inp:text;
begin
assign(inp,fi);
reset(inp);
readln(inp,n);
close(inp);
end;
function toChar(c:longint):char;
begin
exit(chr(c+48));
end;
function toNum(c:char):longint;
begin
exit(ord(c)-48);
end;
function toBase3(n:longint):string;
var s:string;
begin
s:='';
while n>0 do
begin
s:=toChar(n mod 3)+s;
n:=n div 3;
end;
exit(s);
end;
function toDec(s:string):longint;
var i,k:longint;
begin
k:=0;
for i:=length(s) downto 1 do
if s[i]='1' then
k:=k+lt[length(s)-i];
exit(k);
end;
procedure init;
var i:longint;
begin
lt[0]:=1;
for i:=1 to 18 do
lt[i]:=3*lt[i-1];
end;
procedure process;
var
carry,i,dr,dl:longint;
begin
SN:=toBase3(n);
sl:='';
sr:='';
dl:=0;
dr:=0;
carry:=0;
for i:=length(SN) downto 1 do
begin
if SN[i] = '0' then
begin
sl:='0'+sl;
carry:=0;
end
else if SN[i] = '1' then
if carry=1 then
begin
sl:='1'+sl;
end
else
sl:='0'+sl
else
if carry = 0 then
begin
sl:='1'+sl;
carry:=1;
end
else
begin
sl:='0'+sl;
end;
end;
sr:=toBase3(toDec(sl)+n);
for i:=1 to length(sl) do
if sl[i]='1' then inc(dl);
for i:=1 to length(sr) do
if sr[i]='1' then inc(dr);
write(dl,' ');
for i:=length(sl) downto 1 do
if sl[i]='1' then
write(lt[length(sl)-i],' ');
writeln;
write(dr,' ');
for i:=length(sr) downto 1 do
if sr[i]='1' then
write(lt[length(sr)-i],' ');
end;
begin
input;
init;
process;
end.