var
n,i,ans:longint;
procedure solve(x:longint);
var
p:longint;
t:longint;
f:boolean;
begin
f:=false;
while x>0 do
begin
t:=x and 1;
if t=1 then
begin
if f then inc(ans);
f:=true;
end
else f:=false;
x:=x shr 1;
end;
end;
begin
assign(input,'bita.in'); reset(input);
assign(output,'bita.out'); rewrite(output);
readln(n);
ans:=0;
for i:=1 to n do
solve(i);
writeln(ans);
close(input); close(output);
end.