view vgranking.c @ 0:e0bbaa717f41 draft default tip

lol J
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Mon, 25 Nov 2013 11:56:30 -0500
parents
children
line wrap: on
line source

/* Copyright 1990-2011, Jsoftware Inc.  All rights reserved. */
/* License in license.txt.                                   */
/*                                                                         */
/* Verbs: Grade -- monad /:@/:"r  on dense arguments                       */

#include "j.h"
#include "vg.h"


#define RANKINGSUMSCAN   \
 {I s,*u; s=0; u=yv; DO(p, if(*u){t=*u; *u=s; s+=t;} ++u;);}
#define RANKINGLOOP(T)   \
 {T*v=(T*)wv;  DO(n, ++yu[*v++];); RANKINGSUMSCAN; v=(T*)wv;  DO(n, *zv++=yu[*v++]++;);}

static A jtrankingb(J jt,A w,I wf,I wcr,I m,I n,I k){A z;C*wv;I i,j,p,t,yv[16],*zv;
 p=2==k?4:16; wv=CAV(w);
 GA(z,INT,m*n,1+wf,AS(w)); if(!wcr)*(AS(z)+wf)=1; zv=AV(z);
 if(2==k){US*v;
  for(i=0;i<m;++i){
   memset(yv,C0,p*SZI); 
   for(j=0,v=(US*)wv;j<n;++j)switch(*v++){
    case BS00: ++yv[0]; break;
    case BS01: ++yv[1]; break;
    case BS10: ++yv[2]; break;
    case BS11: ++yv[3]; break;
   }
   RANKINGSUMSCAN;
   for(j=0,v=(US*)wv;j<n;++j)switch(*v++){
    case BS00: *zv++=yv[0]++; break;
    case BS01: *zv++=yv[1]++; break;
    case BS10: *zv++=yv[2]++; break;
    case BS11: *zv++=yv[3]++; break;
   }
   wv+=n*k;
 }}else{int*v;
  for(i=0;i<m;++i){
   memset(yv,C0,p*SZI); 
   for(j=0,v=(int*)wv;j<n;++j)switch(*v++){
    case B0000: ++yv[ 0]; break;
    case B0001: ++yv[ 1]; break;
    case B0010: ++yv[ 2]; break;
    case B0011: ++yv[ 3]; break;
    case B0100: ++yv[ 4]; break;
    case B0101: ++yv[ 5]; break;
    case B0110: ++yv[ 6]; break;
    case B0111: ++yv[ 7]; break;
    case B1000: ++yv[ 8]; break;
    case B1001: ++yv[ 9]; break;
    case B1010: ++yv[10]; break;
    case B1011: ++yv[11]; break;
    case B1100: ++yv[12]; break;
    case B1101: ++yv[13]; break;
    case B1110: ++yv[14]; break;
    case B1111: ++yv[15]; break;
   }
   RANKINGSUMSCAN;
   for(j=0,v=(int*)wv;j<n;++j)switch(*v++){
    case B0000: *zv++=yv[ 0]++; break;
    case B0001: *zv++=yv[ 1]++; break;
    case B0010: *zv++=yv[ 2]++; break;
    case B0011: *zv++=yv[ 3]++; break;
    case B0100: *zv++=yv[ 4]++; break;
    case B0101: *zv++=yv[ 5]++; break;
    case B0110: *zv++=yv[ 6]++; break;
    case B0111: *zv++=yv[ 7]++; break;
    case B1000: *zv++=yv[ 8]++; break;
    case B1001: *zv++=yv[ 9]++; break;
    case B1010: *zv++=yv[10]++; break;
    case B1011: *zv++=yv[11]++; break;
    case B1100: *zv++=yv[12]++; break;
    case B1101: *zv++=yv[13]++; break;
    case B1110: *zv++=yv[14]++; break;
    case B1111: *zv++=yv[15]++; break;
   }
   wv+=n*k;
 }}
 R z;
}    /* /:@/: w where w is boolean and items have length 2 or 4 */

F1(jtranking){A y,z;C*wv;I i,k,m,n,p=0,q=0,t,wcr,wf,wk,wr,*ws,wt,*yu,*yv,*zv;
 RZ(w);
 wr=AR(w); wcr=jt->rank?jt->rank[1]:wr; wf=wr-wcr; jt->rank=0;
 wt=AT(w); wv=CAV(w);
 ws=AS(w); n=wcr?ws[wf]:1; RE(m=prod(wf,ws));
 if(!AN(w))R m?reitem(vec(INT,wf,ws),iota(v2(1L,n))):reshape(vec(INT,1+wf,ws),zero);
 wk=bp(wt); k=wk*(wcr?prod(wcr-1,ws+wf+1):1);  
 if(wt&B01&&(k==2||k==sizeof(int)))R rankingb(w,wf,wcr,m,n,k);
 else switch(k){
  case 1:   p=wt&B01?2:256; break;
  case 2:   p=65536; break;
  case sizeof(int): 
   if(wt&INT){irange(AN(w)/(k/wk),(I*)wv,&q,&p); if(!(65536>p||0.69*(p+2*n)<n*log((D)n)))p=0;}
 }
 if(!p){
  RZ(y=irs1(w,0L,wcr,jtgrade1)); yv=AV(y); 
  GA(z,INT,m*n,1+wf,ws); if(!wcr)*(AS(z)+wf)=1; zv=AV(z); 
  DO(m, DO(n, zv[*yv++]=i;); zv+=n;);
  R z;
 }
 GA(z,INT,m*n,1+wf,ws); if(!wcr)*(AS(z)+wf)=1; zv=AV(z);
 GA(y,INT,p,1,0); yv=AV(y); yu=yv-q;
 for(i=0;i<m;++i){
  memset(yv,C0,p*SZI);
  switch(k){
   case sizeof(int): RANKINGLOOP(int); break;
   case sizeof(C):   RANKINGLOOP(UC); break;
#if SYS & SYS_LILENDIAN
   case sizeof(S):
    if(wt&IS1BYTE){I c,d,s,t,*u;US*v;
     v=(US*)wv; DO(n, ++yu[*v++];);
     s=0;       DO(256, c=0; d=i; DO(256, u=yv+(c+d); c+=256; if(*u){t=*u; *u=s; s+=t;}););
     v=(US*)wv; DO(n, *zv++=yu[*v++]++;);
    }else RANKINGLOOP(US);
#else
   case sizeof(S):   RANKINGLOOP(US);
#endif
  }
  wv+=n*k;
 }
 R z;
}