CHEAT - Chơi bi-a 1 lỗ

Tác giả: khuc_tuan

Ngôn ngữ: Pascal

const
	maxn = 100000;

var
	bit, vt, a : array[1..maxn] of longint;
	x, k, t, p, i, j, n : longint;
	f : array[0..16,1..maxn] of longint;
	
procedure add(i, v : longint);
begin
	while i<=n do begin
		inc(bit[i],v);
		inc(i,i and (-i));
	end;
end;

function tinh(i : longint) : longint;
var res : longint;
begin
	res := 0;
	while i>0 do begin
		inc(res,bit[i]);
		i := i and (i-1);
	end;
	tinh := res;
end;

function find(i : longint) : longint;
var
	l, r, m, a : longint;
begin
	a := tinh(i);
	l := 1;
	r := i;
	while l<r do begin
		m := (l+r) div 2;
		if tinh(m)=a then r := m
		else l := m+1;
	end;
	find := l;
end;
	
begin
	read(n);
	for i:=1 to n do begin
		read(a[i]);
		vt[a[i]] := i;
		f[0,i] := a[i];
	end;
	p := 1;
	for i:=1 to 16 do begin
		for j:=1 to n-p+1 do begin
			f[i,j] := f[i-1,j+p];
			if f[i,j]>f[i-1,j] then f[i,j] := f[i-1,j];
		end;
		p := 2*p;
	end;
	for i:=n downto 1 do begin
		if (i<=n-2) and (tinh(a[i])>0) then begin
			j := vt[find(a[i])];
			t := trunc(ln(j-i+1)/ln(2) + 1e-9);
			p := 1;
			for x:=1 to t do p:=2*p;
			k := f[t,j-p+1];
			if k>f[t,i] then k := f[t,i];
			if k<a[j] then begin
				writeln('YES');
				exit;
			end;
		end;
		add(a[i],1);
	end;
	writeln('NO');
end.

Download