/*****************************************************************************************************************
 
SAS file name: binary_search.sas
File location: 
__________________________________________________________________________________________________________________
 
Purpose: To provide code for binary search of an array in the SAS data step
Author: Peter Clemmensen
Creation Date: 09/22/2020
 
This program supports the blog post "Perform a Binary Search of an Array in SAS" on SASnrd.com

*****************************************************************************************************************/

/* Clean log and output */
dm log "clear";
dm output "clear";

/* A simple binary search of a temporary array */
data _null_;
   array k {10} _temporary_     ( 1    2    3    4    5    6    7    8    9    10);
   array d {10} $ 1 _temporary_ ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j');

   key = 3;

   l = lbound(k);
   h = hbound(k);
   x = .;

   do until (l > h);
      m = floor((l + h) * .5);
      if      key < k[m] then h = m - 1;
      else if key > k[m] then l = m + 1;
      else do;
         data = d[m];
         leave;
      end;
   end;

   put key = / data =;
run;


%let n = 10000000;

/* A matter of speed */
data _null_;
   array k {&n.} _temporary_;
   array d {&n.} _temporary_;
   call streaminit(123);

   do x = 1 to &n.;
      k [x] = x;
      d [x] = rand('integer', 1, 1e4);
   end;

   key = 654321;

   /* sequential search */
   t = time();
   do _N_ = 1 to 10000;
      do x = lbound(k) to hbound(k);
         if k[x] = key then do;
            data = d[x];
            leave;
         end;
      end;
   end;
   et = time() - t;
   put et=;

   put key = / data =;

run;


data _null_;
   array k {%sysevalf(&n. + 1)} _temporary_;
   array d {&n.}                _temporary_;
   call streaminit(123);

   do x = 1 to &n.;
      k [x] = x;
      d [x] = rand('integer', 1, 1e4);
   end;

   key = 654321;

   /* sequential search */
   t = time();
   do _N_ = 1 to 10000;
      k [hbound(k)] = key;
      x = lbound(k) + 1;
      do until (k[x] = key);
         x ++ 1;
      end;
      data = d[x];
   end;
   et = time() - t;
   put et=;

   put key = / data =;

run;

/* Binary search */
data _null_;
   array k {&n.} _temporary_;
   array d {&n.} _temporary_;
   call streaminit(123);

   do x = 1 to &n.;
      k [x] = x;
      d [x] = rand('integer', 1, 1e4);
   end;

   key = 654321;

   t = time();
   do _N_ = 1 to 10000;
      l = lbound(k);
      h = hbound(k);
      x = .;
      do until (l > h);
         m = floor((l + h) * .5);
         if      key < k[m] then h = m - 1;
         else if key > k[m] then l = m + 1;
         else do;
            data = d[m];
            leave;
         end;
      end;
   end;
   et = time() - t;
   put et=;

   put key = / data =;

run;

/* Uniform binary search */
data _null_;
   array k {0 : &n.} _temporary_;
   array d {    &n.} _temporary_;
   call streaminit(123);

   do x = 1 to &n.;
      k [x] = x;
      d [x] = rand('integer', 1, 1e4);
   end;

   key = 654321;

   array b {50} ;
   diff = dim(k) - 1;
   do p = 1 to log2(&n.);
     diff = diff * .5; 
     b[p] = floor(diff + .5);
   end;

   k[0] = .;

   t = time();
   do _N_ = 1 to 10000;
      x    = .;
      p    = 1;
      m    = b[1];
      diff = b[1];
      do while (diff > 0);
         p + 1;
         diff = b[p];
         if      key < k[m] then m +- diff;
         else if key > k[m] then m +  diff;
         
         else do;
            data = d[m];
            leave;
         end;
         
      end;
   end;
   et = time() - t;
   put et=;

   put key = / data =;

run;

/* The quicksort macro */

 %Macro Qsort (
   Arr = /* Parallel array name list */
   ,By = %QScan(&Arr,1,%Str( )) /* Key array name */
   ,Seq = A /* Seq=D for descending */
   ,LB = Lbound(&By) /* Lower bound to sort */
   ,HB = Hbound(&By) /* Upper bound to sort */
   ,M = 9 /* Tuning range: (1:15) */
  );

  %Local _ H I J L N P Q S T W ;

  %Macro Swap (I,J) ;
    %Local W ;
     Do ;
       %Do W = 1 %To &N ;
         &T&W      = &&A&W(&I) ;
         &&A&W(&I) = &&A&W(&J) ;
         &&A&W(&J) =  &T&W     ;
       %End ;
    End ;
  %Mend Swap ;

  %If %Upcase(&Seq) = %Upcase(A) %Then %Let Q = G ;
  %Else                                %Let Q = L ;

  %Do %Until (&&A&N EQ ) ;
    %Let N  = %Eval(&N + 1) ;
    %Local A&N ;
    %Let A&N = %Scan(&Arr,&N,%Str( )) ;
  %End ;
  %Let N = %Eval(&N - 1) ;

  %Let _ = %Substr(%Sysfunc(Ranuni(0)),3,
  %Eval(7 - %Length(&N) + 5*(%Substr(&Sysver,1,1) GT 6))) ;

  %Let H = H&_ ; %Let I = I&_ ; %Let J = J&_ ; %Let L = L&_ ;
  %Let P = P&_ ; %Let S = S&_ ; %Let T = T&_ ; %Let Z = Z&_ ;

  Array &Z (0:1, 0:50) _Temporary_ ;

  &L = &LB ; &H = &HB ;

  If &H - &L GT &M Then Do &S=1 By 0 While (&S) ;
    &J = (&H - &L)/3 ; &I = &L + &J ; &J = &I + &J ;
    If &By(&L) &Q.T &By(&I) Then %Swap(&L,&I) ;
    If &By(&I) &Q.T &By(&J) Then %Swap(&I,&J) ;
    If &By(&J) &Q.T &By(&H) Then %Swap(&J,&H) ;
    If &By(&L) &Q.T &By(&I) Then %Swap(&L,&I) ;
    If &By(&I) &Q.T &By(&J) Then %Swap(&I,&J) ;
    If &By(&L) &Q.T &By(&I) Then %Swap(&L,&I) ;

    %If &M LE 3 %Then %Do ;
      If &H - &L LE 3 Then Do ;
        &L = &Z(0,&S) ; &H = &Z(1,&S) ; &S +- 1 ;
        Continue ;
      End ;
    %End ;

    %Swap(&L,&I) ; &P = &By(&L) ; &I = &L ;

    Do &J=&H + 1 By 0 ;
      Do &I=&I + 1 By  + 1 Until(&By(&I) &Q.E &P) ; End ;
      Do &J=&J - 1 By  - 1 Until(&P &Q.E &By(&J)) ; End ;
      If &I GE &J Then Leave ;
      %Swap(&I,&J) ;
    End ;

    %Swap(&L,&J) ;

    If      &H - &J GE &J - &L GT &M Then Do &S = &S + 1 ;
      &Z(0,&S) = &J + 1 ; &Z(1,&S) = &H ; &H = &J - 1 ;
    End ;
    Else If &J - &L GE &H - &J GT &M Then Do &S = &S + 1 ;
      &Z(0,&S) = &L ; &Z(1,&S) = &J - 1 ; &L = &J + 1 ;
    End ;
    Else If &J - &L GT &M GE &H - &J Then &H = &J - 1 ;
    Else If &H - &J GT &M GE &J - &L Then &L = &J + 1 ;
    Else Do ;
      &L = &Z(0,&S) ; &H = &Z(1,&S) ; &S +- 1 ;
    End ;
  End ;

  %If &M = 1 %Then %Goto Exit ;

  Do &J = &LB + 1 To &HB ;
    If &By(&J - 1) &Q.T &By(&J) Then Do ;
      &P = &By(&J) ;
      %Do W = 1 %To &N ;
        %If &&A&W Ne &By %Then &T&W = &&A&W(&J)  ;  ;
      %End ;
      Do &I = &J - 1 To &LB By  - 1 ;
        If &P &Q.E &By(&I) Then Leave ;
        %Do W = 1 %To &N ;
          &&A&W(&I + 1) = &&A&W(&I) ;
        %End ;
      End ;
      &By(&I + 1) = &P ;
      %Do W = 1 %To &N ;
        %If &&A&W Ne &By %Then &&A&W(&I + 1) = &T&W ; ;
      %End ;
    End ;
  End ;

  %Exit: Drop &H &I &J &L &P &S T&_: ;

%Mend Qsort ;