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.

Download