Array.pmod

#define error(X) throw( ({ (X), backtrace()[0..sizeof(backtrace())-2] }) )

constant diff = __builtin.diff;
constant diff_longest_sequence = __builtin.diff_longest_sequence;
constant diff_compare_table = __builtin.diff_compare_table;
constant longest_ordered_sequence = __builtin.longest_ordered_sequence;
constant interleave_array = __builtin.interleave_array;

constant sort = __builtin.sort;
constant everynth = __builtin.everynth;
constant splice = __builtin.splice;
constant transpose = __builtin.transpose;

mixed map(mixed arr, mixed fun, mixed ... args)
{
  int e;
  mixed *ret;

  if(mappingp(arr))
    return mkmapping(indices(arr),map(values(arr),fun,@args));

  if(multisetp(arr))
    return mkmultiset(map(indices(arr,fun,@args)));

  switch(sprintf("%t",fun))
  {
  case "int":
    return arr(@args);

  case "string":
    return column(arr, fun)(@args);

  case "function":
  case "program":
  case "object":
    ret=allocate(sizeof(arr));
    for(e=0;e<sizeof(arr);e++)
      ret[e]=fun(arr[e],@args);
    return ret;

  default:
    error("Bad argument 2 to Array.map().\n");
  }
}

mixed filter(mixed arr, mixed fun, mixed ... args)
{
  int e;
  mixed *ret;

  if(mappingp(arr))
  {
    mixed *i, *v, r;
    i=indices(arr);
    ret=map(v=values(arr),fun,@args);
    r=([]);
    for(e=0;e<sizeof(ret);e++) if(ret[e]) r[i[e]]=v[e];

    return r;
  }
  if(multisetp(arr))
  {
    return mkmultiset(filter(indices(arr,fun,@args)));
  }
  else
  {
    int d;
    ret=map(arr,fun,@args);
    for(e=0;e<sizeof(arr);e++) if(ret[e]) ret[d++]=arr[e];
    
    return ret[..d-1];
  }
}

array shuffle(array arr)
{
  int i = sizeof(arr);

  while(i) {
    int j = random(i--);
    if (j != i) {
      mixed tmp = arr[i];
      arr[i] = arr[j];
      arr[j] = tmp;
    }
  }
  return(arr);
}

array permute(array a,int n)
{
   int q=sizeof(a);
   int i;
   a=a[..]; // copy
   
   while (n && q)
   {
      int x=n%q; 
      n/=q; 
      q--; 
      if (x) [a[i],a[i+x]]=({ a[i+x],a[i] });
      i++;
   }  
   
   return a;
}

int search_array(mixed *arr, mixed fun, mixed ... args)
{
  int e;

  if(stringp(fun))
  {
    for(e=0;e<sizeof(arr);e++)
      if(arr[e][fun](@args))
	return e;
    return -1;
  }
  else if(functionp(fun))
  {
    for(e=0;e<sizeof(arr);e++)
      if(fun(arr[e],@args))
	return e;
    return -1;
  }
  else if(intp(fun))
  {
    for(e=0;e<sizeof(arr);e++)
      if(arr[e](@args))
	return e;
    return -1;
  }
  else
  {
    error("Bad argument 2 to filter().\n");
  }
}

mixed *sum_arrays(function foo, mixed * ... args)
{
  mixed *ret;
  int e,d;
  ret=allocate(sizeof(args[0]));
  for(e=0;e<sizeof(args[0]);e++)
    ret[e]=foo(@ column(args, e));
  return ret;
}

mixed *sort_array(array foo,function|void cmp, mixed ... args)
{
  array bar,tmp;
  int len,start;
  int length;
  int foop, fooend, barp, barend;

  if(!cmp || cmp==`>)
  {
    foo+=({});
    sort(foo);
    return foo;
  }

  if(cmp == `<)
  {
    foo+=({});
    sort(foo);
    return reverse(foo);
  }

  length=sizeof(foo);

  foo+=({});
  bar=allocate(length);

  for(len=1;len<length;len*=2)
  {
    start=0;
    while(start+len < length)
    {
      foop=start;
      barp=start+len;
      fooend=barp;
      barend=barp+len;
      if(barend > length) barend=length;
      
      while(1)
      {
	if(cmp(foo[foop],foo[barp],@args) <= 0)
	{
	  bar[start++]=foo[foop++];
	  if(foop == fooend)
	  {
	    while(barp < barend) bar[start++]=foo[barp++];
	    break;
	  }
	}else{
	  bar[start++]=foo[barp++];
	  if(barp == barend)
	  {
	    while(foop < fooend) bar[start++]=foo[foop++];
	    break;
	  }
	}
      }
    }
    while(start < length) bar[start]=foo[start++];

    tmp=foo;
    foo=bar;
    bar=tmp;
  }

  return foo;
}

array uniq(array a)
{
  return indices(mkmapping(a,a));
}

array columns(array x, array ind)
{
  array ret=allocate(sizeof(ind));
  for(int e=0;e<sizeof(ind);e++) ret[e]=column(x,ind[e]);
  return ret;
}

array transpose_old(array x)
{
   if (!sizeof(x)) return x;
   array ret=allocate(sizeof(x[0]));
   for(int e=0;e<sizeof(x[0]);e++) ret[e]=column(x,e);
   return ret;
}

// diff3, complement to diff

array(array(array)) diff3 (array a, array b, array c)
{
  // This does not necessarily produce the optimal sequence between
  // all three arrays. A diff_longest_sequence() that takes any number
  // of arrays would be nice.
  array(int) seq_ab = diff_longest_sequence (a, b);
  array(int) seq_bc = diff_longest_sequence (b, c);
  array(int) seq_ca = diff_longest_sequence (c, a);

  array(int) aeq = allocate (sizeof (a) + 1);
  array(int) beq = allocate (sizeof (b) + 1);
  array(int) ceq = allocate (sizeof (c) + 1);
  aeq[sizeof (a)] = beq[sizeof (b)] = ceq[sizeof (c)] = 7;

  for (int i = 0, j = 0; j < sizeof (seq_ab); i++)
    if (a[i] == b[seq_ab[j]]) aeq[i] |= 2, beq[seq_ab[j]] |= 1, j++;
  for (int i = 0, j = 0; j < sizeof (seq_bc); i++)
    if (b[i] == c[seq_bc[j]]) beq[i] |= 2, ceq[seq_bc[j]] |= 1, j++;
  for (int i = 0, j = 0; j < sizeof (seq_ca); i++)
    if (c[i] == a[seq_ca[j]]) ceq[i] |= 2, aeq[seq_ca[j]] |= 1, j++;

  array(array) ares = ({}), bres = ({}), cres = ({});
  int ai = 0, bi = 0, ci = 0;
  int prevodd = -2;

  while (!(aeq[ai] & beq[bi] & ceq[ci] & 4)) {
    /* werror ("aeq[%d]=%d beq[%d]=%d ceq[%d]=%d prevodd=%d\n",
       ai, aeq[ai], bi, beq[bi], ci, ceq[ci], prevodd); */
    array empty = ({}), apart = empty, bpart = empty, cpart = empty;
    int intersect;

    if (aeq[ai] == 2 && beq[bi] == 1) { // a and b are equal.
      do apart += ({a[ai++]}), bi++; while (aeq[ai] == 2 && beq[bi] == 1);
      bpart = apart;
      while (!ceq[ci]) cpart += ({c[ci++]});
      prevodd = 2;
    }
    else if (beq[bi] == 2 && ceq[ci] == 1) { // b and c are equal.
      do bpart += ({b[bi++]}), ci++; while (beq[bi] == 2 && ceq[ci] == 1);
      cpart = bpart;
      while (!aeq[ai]) apart += ({a[ai++]});
      prevodd = 0;
    }
    else if (ceq[ci] == 2 && aeq[ai] == 1) { // c and a are equal.
      do cpart += ({c[ci++]}), ai++; while (ceq[ci] == 2 && aeq[ai] == 1);
      apart = cpart;
      while (!beq[bi]) bpart += ({b[bi++]});
      prevodd = 1;
    }
    else if ((intersect = aeq[ai] & beq[bi] & ceq[ci]) == 3) { // All are equal.
      do apart += ({a[ai++]}), bi++, ci++; while (aeq[ai] & beq[bi] & ceq[ci] == 3);
      cpart = bpart = apart;
      prevodd = -1;
    }
    else {
      // Haven't got any equivalences in this block. Avoid adjacent
      // complementary blocks (e.g. ({({"foo"}),({}),({})}) next to
      // ({({}),({"bar"}),({"bar"})})). Besides that, leave the
      // odd-one-out sequence empty in a block where two are equal.

      if (intersect && (aeq[ai] | beq[bi] | ceq[ci]) != 3) {
	// Got cyclically interlocking equivalences. Have to break one
	// of them. Prefer the shortest.
	int which, newblock, mask, i, oi;
	array(int) eq, oeq;
	array arr;
	for (i = 0;; i++)
	  if (aeq[ai] != aeq[ai + i]) {
	    which = 0, newblock = prevodd != 0 && (prevodd == -2 || sizeof (ares[-1]));
	    mask = aeq[ai] ^ 3, i = ai, eq = aeq, arr = a;
	    if (mask == 1) oi = bi, oeq = beq; else oi = ci, oeq = ceq;
	    break;
	  }
	  else if (beq[bi] != beq[bi + i]) {
	    which = 1, newblock = prevodd != 1 && (prevodd == -2 || sizeof (bres[-1]));
	    mask = beq[bi] ^ 3, i = bi, eq = beq, arr = b;
	    if (mask == 1) oi = ci, oeq = ceq; else oi = ai, oeq = aeq;
	    break;
	  }
	  else if (ceq[ci] != ceq[ci + i]) {
	    which = 2, newblock = prevodd != 2 && (prevodd == -2 || sizeof (cres[-1]));
	    mask = ceq[ci] ^ 3, i = ci, eq = ceq, arr = c;
	    if (mask == 1) oi = ai, oeq = aeq; else oi = bi, oeq = beq;
	    break;
	  }
	/* werror ("which=%d newblock=%d mask=%d i=%d oi=%d\n",
	   which, newblock, mask, i, oi); */
	if (newblock)
	  ares += ({empty}), bres += ({empty}), cres += ({empty}), prevodd = -1;
	while (oeq[oi] != mask) oi++;
	array part = ({});
	mask ^= 3;
	do part += ({arr[i++]}), oeq[oi++] = 0; while (eq[i] == mask);
	switch (which) {
	  case 0: ai = i; ares[-1] += part; break;
	  case 1: bi = i; bres[-1] += part; break;
	  case 2: ci = i; cres[-1] += part; break;
	}
	continue;
      }

      else {
	if (intersect) {
	  // One matches on both sides and the other two doesn't match
	  // each other. This occurs when the matches aren't
	  // synchronized. E.g. for a = ({"a"}), b = ({"b","a"}), c =
	  // ({"a","b","a"}) we got a[0]->b[1], b[0..1]->c[1..2],
	  // c[0]->a[0]. We shift the match forward to catch the
	  // all-three match later, i.e. replace c[0]->a[0] with
	  // c[2]->a[0] in this case.
	  int i;
	  array(int) eq;
	  array arr;
	  if (aeq[ai] == 3)
	    if (intersect == 1) i = bi, eq = beq, arr = b; else i = ci, eq = ceq, arr = c;
	  else if (beq[bi] == 3)
	    if (intersect == 1) i = ci, eq = ceq, arr = c; else i = ai, eq = aeq, arr = a;
	  else
	    if (intersect == 1) i = ai, eq = aeq, arr = a; else i = bi, eq = beq, arr = b;
	  while (eq[i] == intersect) {
	    mixed el = arr[i];
	    eq[i] = 0;
	    int j = ++i;
	    while (arr[j] != el || eq[j] & intersect) j++;
	    eq[j] |= intersect;
	  }
	}

	switch (prevodd) {
	  case 0: apart = ares[-1], ares[-1] = ({}); break;
	  case 1: bpart = bres[-1], bres[-1] = ({}); break;
	  case 2: cpart = cres[-1], cres[-1] = ({}); break;
	}
	prevodd = -1;
	while (!aeq[ai]) apart += ({a[ai++]});
	while (!beq[bi]) bpart += ({b[bi++]});
	while (!ceq[ci]) cpart += ({c[ci++]});
      }
    }

    ares += ({apart}), bres += ({bpart}), cres += ({cpart});
  }

  return ({ares, bres, cres});
}

// diff3, complement to diff (alpha stage)

array(array(array(mixed))) diff3_old(array mid,array left,array right)
{
   array lmid,ldst;
   array rmid,rdst;

   [lmid,ldst]=diff(mid,left);
   [rmid,rdst]=diff(mid,right);

   int l=0,r=0,n;
   array res=({});
   int lpos=0,rpos=0;
   array eq=({});
   int x;

   for (n=0; ;)
   {
      while (l<sizeof(lmid) && lpos>=sizeof(lmid[l]))
      {
	 if (sizeof(ldst[l])>lpos)
	    res+=({({({}),ldst[l][lpos..],({})})});
	 l++;
	 lpos=0;
      }
      while (r<sizeof(rmid) && rpos>=sizeof(rmid[r])) 
      {
	 if (sizeof(rdst[r])>rpos)
	    res+=({({({}),({}),rdst[r][rpos..]})});
	 r++;
	 rpos=0;
      }

      if (n==sizeof(mid)) break;

      x=min(sizeof(lmid[l])-lpos,sizeof(rmid[r])-rpos);

      if (lmid[l]==ldst[l] && rmid[r]==rdst[r])
      {
	 eq=lmid[l][lpos..lpos+x-1];
	 res+=({({eq,eq,eq})});
      }
      else if (lmid[l]==ldst[l])
      {
	 eq=lmid[l][lpos..lpos+x-1];
	 res+=({({eq,eq,rdst[r][rpos..rpos+x-1]})});
      }
      else if (rmid[r]==rdst[r])
      {
	 eq=rmid[r][rpos..rpos+x-1];
	 res+=({({eq,ldst[l][lpos..lpos+x-1],eq})});
      }
      else 
      {
	 res+=({({lmid[l][lpos..lpos+x-1],
		  ldst[l][lpos..lpos+x-1],
		  rdst[r][rpos..rpos+x-1]})});
      }

//        werror(sprintf("-> %-5{%O%} %-5{%O%} %-5{%O%}"
//  		     " x=%d l=%d:%d r=%d:%d \n",@res[-1],x,l,lpos,r,rpos));
	 
      rpos+=x;
      lpos+=x;
      n+=x;
   }
   
   return transpose(res);
}