Problem:
Score : 600 points

Problem Statement

You are given an integer sequence of length N, a = {a_1, a_2, …, a_N}, and an integer K.

a has N(N+1)/2 non-empty contiguous subsequences, {a_l, a_{l+1}, …, a_r} (1 ≤ l ≤ r ≤ N). Among them, how many have an arithmetic mean that is greater than or equal to K?

Constraints

All input values are integers.

1 ≤ N ≤ 2 \times 10^5

1 ≤ K ≤ 10^9

1 ≤ a_i ≤ 10^9

Input

Input is given from Standard Input in the following format:

N K
a_1
a_2
:
a_N

Output

Print the number of the non-empty contiguous subsequences with an arithmetic mean that is greater than or equal to K.

Sample Input 1

3 6
7
5
7

Sample Output 1

5

All the non-empty contiguous subsequences of a are listed below:

{a_1} = {7}

{a_1, a_2} = {7, 5}

{a_1, a_2, a_3} = {7, 5, 7}

{a_2} = {5}

{a_2, a_3} = {5, 7}

{a_3} = {7}

Their means are 7, 6, 19/3, 5, 6 and 7, respectively, and five among them are 6 or greater. Note that {a_1} and {a_3} are indistinguishable by the values of their elements, but we count them individually.

Sample Input 2

1 2
1

Sample Output 2

0

Sample Input 3

7 26
10
20
30
40
30
20
10

Sample Output 3

13

Solution in Pascal (FPC 2.6.2) (judge verdict: Runtime Error)

program j01;
const maxn=200086;
type opr=record w:int64;id:longint;end;
var a,sum:array[0..maxn]of int64;
    op:array[0..maxn]of opr;
    tot:longint;
    ans:int64;
    c:array[0..maxn]of longint;
    n,i,k:longint;

procedure sort(l,r:longint);
var i,j,x:longint;y:opr;
begin
  i:=l;j:=r;x:=op[(i+j)div 2].w;
  repeat
    while op[i].w<x do inc(i);
    while x<op[j].w do dec(j);
    if i<=j then
    begin
      y:=op[i];op[i]:=op[j];op[j]:=y;
      inc(i);dec(j);
    end;
  until i>j;
  if i<r then sort(i,r);
  if l<j then sort(l,j);
end;

procedure disc;
var i:longint;
begin
  sort(1,n);
  tot:=1;a[op[1].id]:=1;
  for i:=2 to n do
  begin
    if op[i].w<>op[i-1].w then inc(tot);
    a[op[i].id]:=tot;
  end;
end;

procedure ins(i:longint);
begin
  while i<=tot do
  begin
    inc(c[i]);inc(i,i and(-i));
  end;
end;

function ask(i:longint):longint;
var res:longint;
begin
  res:=0;
  while i>0 do
  begin
    inc(res,c[i]);dec(i,i and(-i));
  end;
  exit(res);
end;

begin
  readln(n,k);
  for i:=1 to n do read(a[i]);
  for i:=1 to n do a[i]:=a[i]-k;
  sum[1]:=0;inc(n);for i:=2 to n do sum[i]:=sum[i-1]+a[i-1];
  for i:=1 to n do
  begin
    op[i].w:=sum[i];op[i].id:=i;
  end;
  //for i:=1 to n do write(sum[i],' ');writeln;
  disc;
  for i:=1 to n do
  begin
    inc(ans,ask(a[i]));ins(a[i]);
  end;
  writeln(ans);
end.