贴两种解决区间k小数的程序

昨天老师布置的作业就有区间k小数= =。。不过那题数据太弱了。。。直接快排一下就ac了= =

 

 

这个题目很经典的- -目前我知道的正解只有这两种。树套树和划分树、（如果区间有重叠不包含，区间排序一下，直接用平衡树解决）

 

好早以前写的。以前是用线段树套个线段树（这个叫归并树来着）。。。归并排序上去- -

首先二分答案logn。。然后进去线段树logn。。然后判断这个数在第几位又logn。。总复杂度是  mlognlognlogn

program p2104; var f:array[0..20,0..1000000]of longint; c:Array[0..21]of longint; A,b:Array[0..1000000]of longint; v:array[0..200000]of boolean; xx,l,r,x,cc,pt:Array[0..1000000]of longint; mid,j,len,n,m:longint; procedure swap(now,a,b:longint); var tmp:longint; begin tmp:=f[now,a];f[now,a]:=f[now,b];f[now,b]:=tmp; end; procedure qsort(now,l,r:longint); var xx,k,yy,i,j:longint; begin k:=random(r-l)+l;swap(now,k,r); xx:=f[now,(l+r) shr 1]; i:=l;j:=r; while i<j do begin while f[now,i]<xx do inc(i); while f[now,j]>xx do dec(j); if i<=j then begin swap(now,i,j); inc(i); deC(j); end; end; if i<r then qsort(now,i,r); if l<j then qsort(now,l,j); end; procedure init; var i,mm:longint; begin readln(n,m); for i:=1 to n do READ(f[0][i]); for i:=1 to m do begin reaD(x[i],x[i+m],cc[i]); v[x[i]]:=true; v[x[i+m]]:=true; end; mm:=0; for i:=1 to n do if v[i] then begin inc(mm); xx[mm]:=i; end; len:=0; for i:=1 to mm do begin inc(len); l[len]:=xx[i]; r[len]:=xx[i]; pt[xx[i]]:=len; if xx[i]<xx[i+1]-1 then begin inc(len); for j:=xx[i]+1 to xx[i+1]-1 do pt[j]:=len; l[len]:=xx[i]+1; r[len]:=xx[i+1]-1; end end; end; procedure merge(dep,tot:longint); var l1,l2:longint; begin l1:=a[tot*2];l2:=a[tot*2+1]; c[dep]:=a[tot]-1; while c[dep]<b[tot] do begin if (l1<=b[tot*2])and((f[dep+1,l1]<f[dep+1,l2])or(l2>b[tot*2+1])) then begin inc(c[dep]); f[dep,c[dep]]:=f[dep+1,l1]; inc(l1); end else begin inc(c[dep]); f[dep,c[dep]]:=f[dep+1,l2]; inc(l2); end; end; end; procedure build(dep,tot,lt,rt:longint); var i:longint; begin if lt=rt then begin for i:=l[lt] to r[rt] do begin f[dep,i]:=f[0,i]; end; a[tot]:=l[lt]; b[tot]:=r[rt]; qsort(dep,l[lt],r[lt]); exit; end; build(dep+1,tot*2,lt,(lt+rt) shr 1); build(dep+1,tot*2+1,(lt+rt) shr 1+1,rt); a[tot]:=a[tot*2]; b[tot]:=b[tot*2+1]; merge(dep,tot); end; function erfen(dep,lt,rt:longint):longint; var md,ll:longint; begin if f[0][mid]<=f[dep,lt] then exit(0); if f[0][mid]>f[dep,rt] then exit(rt-lt+1); ll:=lt; while lt+1<rt do begin md:=(lt+rt) div 2; if f[dep,md]<f[0][mid] then lt:=md else rt:=md; end; erfen:=lt-ll+1; end; function find(dep,lt,rt,ll,rr:longint):longint; var t1,t2:longint; begin if (ll<=lt)and(rt<=rr) then begin exit(erfen(dep,l[lt],r[rt])); end; t1:=0;t2:=0; if ll<=(lt+rt) shr 1 then t1:=find(dep+1,lt,(lt+rt) shr 1,ll,rr); if rr>(lt+rt) shr 1 then t2:=find(dep+1,(lt+rt) shr 1+1,rt,ll,rr); exit(t1+t2); end; procedure main; var i,lt,rt:longint; begin build(1,1,1,len); qsort(0,1,n); for i:=1 to m do begin lt:=1; rt:=n+1; while lt+1<rt do begin mid:=(lt+rt) shr 1; if find(1,1,len,pt[x[i]],pt[x[i+m]])<cc[i] then lt:=mid else rt:=mid; end; writeln(f[0][lt]); end; end; begin assign(input,'1.in');assign(output,'1.out'); reset(input);rewrite(output); randomize; init; main; close(input);close(output); end.

 

今天顺便学了一下划分树。。。好牛逼的结构- -。nlogn解决之。。

program Project1; var tmp,n,m:longint; num,a,aa:array[0..20000]of longint; sum,p:array[0..20,0..20000]of longint; procedure qsorT(l,r:longint); var mid,i,j:longint; begin mid:=a[(l+r) shr 1]; i:=l;j:=r; repeat while a[i]<mid do inc(i); while a[j]>mid do dec(j); if i<=j then begin tmp:=a[i]; a[i]:=a[j]; a[j]:=tmp; tmp:=num[i]; num[i]:=num[j]; num[j]:=tmp; inc(i);dec(j); end; until i>j; if l<j then qsort(l,j); if i<r then qsort(i,r); end; procedure build(dep,l,r:longint); var mid,i,j,t:longint; begin if (l=r) then begin p[dep,l]:=num[l]; exit; end; mid:=(l+r) shr 1; build(dep+1,mid+1,r); build(dep+1,l,mid); i:=l;j:=mid+1; t:=l; while (i<=mid)or(j<=r) do if ((p[dep+1,i]<p[dep+1,j])and(i<=mid))or(j>r) then begin sum[dep,t]:=sum[dep,t-1]+1; p[dep,t]:=p[dep+1,i]; inc(i); inc(t); end else begin sum[dep,t]:=sum[dep,t-1]; p[dep,t]:=p[dep+1,j]; inc(j); inc(t); end; end; procedure init; var i:longint; begin readln(n,m); for i:=1 to n do read(a[i]); aa:=a; for i:=1 to n do num[i]:=i; qsort(1,n); build(1,1,n); end; procedure dfs(dep,l,r,ll,rr,k:longint); var mid,add:longint; begin if (l=r) then begin writeln(aa[p[dep,l]]); exit; end; mid:=(l+r) shr 1; if ll=l then add:=0 else add:=sum[dep,ll-1]; if sum[dep,rr]-add>=k then dfs(dep+1,l,mid,l+add,l+sum[dep,rr]-1,k) else dfs(dep+1,mid+1,r,mid+(ll-l+1)-add,mid+(rr-l+1)-sum[dep,rr],k-(sum[dep,rr]-add)); end; procedure main; var i,l,r,k:longint; begin for i:=1 to m do begin readln(l,r,k); dfs(1,1,n,l,r,k); end; end; begin init; main; end.