code map thôi đủ mệt rồi =))
chán mí bạn ghê á!!!!
uses math;
var n,i:longint;
s:int64;
f:array[-10..1000000] of int64;
procedure dq(n:longint);
begin
if n<=1000000 then
begin
s:=s+f[n];
exit;
end
else
begin
dq(n div 2);
dq(n div 3);
dq(n div 4);
end;
end;
begin
assign(input,'dprc.inp');reset(input);
assign(output,'dprc.out');rewrite(output);
for i:=1 to 1000000 do
begin
f[i]:=max(i,f[i div 2]+f[i div 3]+f[i div 4]);
//write(f[i],' ');
end;
while not seekeof do
begin
readln(n);
s:=0;
dq(n);
writeln(s);
end;
end.