Rcpp: the Shell sort code with gaps function exemples

/*
 * The method starts by sorting pairs of elements far apart from each other, then progressively reducing the gap between elements to be compared.
 * The running time of Shellsort is heavily dependent on the gap sequence it uses.
 * Many gap function are evaluable see Link.
 * source file:Rcpp: the Shell sort code with gaps function exemples

 * 
 * The best profile was effectuated when we use sort_shell_sed function.
 * 
 *                                 MACHERKI M E.
 *                                 17/02/2016
 * 
 * 
 */

#include <Rcpp.h>
using namespace Rcpp;



//The following code is the typical body of the shell sort algorithm:
inline void shell ( NumericVector unsorted, int size, NumericVector Gaps)
{
  int gn=Gaps.size();
  int j,gap ;
  
  for (int t = gn-1; t > -1; t--)
  {
    gap=Gaps[t];
    for (int i = gap; i < size; ++i)
    {
      double temp = unsorted[i];
      for (j = i; j >= gap && temp < unsorted[j - gap]; j -= gap)
      {
        unsorted[j] = unsorted[j - gap];
      }
      unsorted[j] = temp;
    } 
  }
}
//******************gaps functions*************************

//Many gaps function can be used 
/*Shell sort function using slicing by two gaps (Shell, 1959)
 Gaps= N/2^k={N/2,N/4,N/8...1}
*/
inline NumericVector gapshell( int size ) {
  NumericVector result;
  for(int i=size/2;i>0;i/=2)
    result.push_back(i);
  return rev(result);}
/*Method of Frank & Lazarus, 1960
 Gaps=2*(N/2^k+1)+1
*/
inline NumericVector gapFrank( int N ) {
  int tmp=10;
  NumericVector result;
  for(int k=2;tmp>1;k++){
    tmp=2*(N/pow(2,k))+1;
    result.push_back(tmp);}
  return rev(result);}

/*Method of Hibbard, 1963
 Gaps=2^k-1
 */
inline NumericVector gapHibbard( int N ) {
  NumericVector result;
  int tmp=0;
  for(int k=1;tmp<N;k++){
    tmp=pow(2,k)-1;
    result.push_back(tmp);}
  return result;}

/*Method of Pratt, 1971
 Gaps=(3^k-1)/2
 */
inline NumericVector gappratt( int N ) {
  int n=N/3;
  NumericVector result;
  int tmp=0;
  for(int k=1;tmp<n;k++){
    tmp=(pow(3,k)-1)/2;
    result.push_back(tmp);}
  return result;}
/*Method of Sedgewick, 1986
 Gaps=4^k+3*2^(k-1)+1
 */
inline NumericVector gapsed( int N ) {
  NumericVector result;
  result.push_back(1);
    int tmp=0;
  for(int k=1;;k++){
    tmp=pow(4,k)+(3*pow(2,k-1))+1;
    if(tmp>N)break;
    result.push_back(tmp);}
  return result;}
/*Method of Tokuda, 1992
 Gaps=(9^k-4^k)/(5*4^(k-1))
*/

inline NumericVector gaptocuda( int N ) {
  NumericVector result;
  int tmp=0;
  for(int k=1;;k++){
    tmp=(pow(9,k)-pow(4,k))/(5*pow(4,k-1));
    if(tmp>N)break;
    result.push_back(tmp);}//we can use tmp+1
  result[0]=1;
  return result;}
/*Method of Tokuda, 1992:generic
 Gaps=h[i]=(h[i-1])*2.25+1; h[1]=1,1 base indexing
*/

inline NumericVector gaptocuda_emp( int N ) {
  NumericVector result;
  result.push_back(1);
  int tmp=1;
  for(int k=1;;k++){
    tmp=2.25*tmp+1;
    if(tmp>N)break;
    result.push_back(tmp);}//we can use tmp+1
  return result;}





//using empirically derived gaps (Ciura, 2001) N<2000

NumericVector gapCiura( int sz ) { 
  NumericVector result;
  result.push_back(1);
  result.push_back(4);
  result.push_back(10);
  result.push_back(23);
  result.push_back(57);
  result.push_back(132);
  result.push_back(301);
  result.push_back(701);
  result.push_back(1705);
  return result;}

/******************sorting functions*************************
************************************************************/







// [[Rcpp::export]]
NumericVector sort_shell_gap(NumericVector unsorted) { //run
  int N =unsorted.size();
  NumericVector gaps=gapshell(N);
  NumericVector result=clone(unsorted);
  shell(result,N,gaps);
  return result;}
// [[Rcpp::export]]
NumericVector sort_shell_frunk(NumericVector unsorted) { //run
  int N =unsorted.size();
  NumericVector gaps=gapFrank(N);
  NumericVector result=clone(unsorted);
  shell(result,N,gaps);
  return result;}
// [[Rcpp::export]]
NumericVector sort_shell_hibbard(NumericVector unsorted) { //run
  int N =unsorted.size();
  NumericVector gaps=gapHibbard(N);
  NumericVector result=clone(unsorted);
  shell(result,N,gaps);
  return result;}
// [[Rcpp::export]]
NumericVector sort_shell_patt(NumericVector unsorted) { //run
  int N =unsorted.size();
  NumericVector gaps=gappratt(N);
  NumericVector result=clone(unsorted);
  shell(result,N,gaps);
  return result;}
// [[Rcpp::export]]
NumericVector sort_shell_sed(NumericVector unsorted) { //run
  int N =unsorted.size();
  NumericVector gaps=gapsed(N);
  NumericVector result=clone(unsorted);
  shell(result,N,gaps);
  return result;}
// [[Rcpp::export]]
NumericVector sort_shell_tacuda(NumericVector unsorted) { //run
  int N =unsorted.size();
  NumericVector gaps=gaptocuda(N);
  NumericVector result=clone(unsorted);
  shell(result,N,gaps);
  return result;}
// [[Rcpp::export]]
NumericVector sort_shell_tacudaemp(NumericVector unsorted) { //run
  int N =unsorted.size();
  NumericVector gaps=gaptocuda_emp(N);
  NumericVector result=clone(unsorted);
  shell(result,N,gaps);
  return result;}
// [[Rcpp::export]]
NumericVector sort_shell_Ciura(NumericVector unsorted) { //run
  int N =unsorted.size();
  NumericVector Ciura=gapCiura(0);
  NumericVector result=clone(unsorted);
  shell(result,N,Ciura);
  return result;}
/***R
##trial mode
x<-runif(1000)
base<-sort(x)
a<-sort_shell_gap(x)
b<-sort_shell_frunk(x)
c<-sort_shell_hibbard(x)
d<-sort_shell_patt(x)
e<-sort_shell_sed(x)
f<-sort_shell_tacuda(x)
g<-sort_shell_tacudaemp(x)
h<-sort_shell_Ciura(x)
all.equal.list(base,a,b,c,e,f,g,h)
## timing :
x<-runif(1000000)
system.time(base<-sort(x))
system.time(a<-sort_shell_gap(x))
system.time(b<-sort_shell_frunk(x))
system.time(c<-sort_shell_hibbard(x))
system.time(d<-sort_shell_patt(x))
system.time(e<-sort_shell_sed(x))
system.time(f<-sort_shell_tacuda(x))
system.time(g<-sort_shell_tacudaemp(x))
system.time(h<-sort_shell_Ciura(x))

*/
  

Merge sort: Rcpp integration code

/*sorting function using the merge sort algorithm
*/

#include <Rcpp.h>
using namespace Rcpp;

void intercal(int p, int q, int r, NumericVector v,  NumericVector w)
{
  int i, j, k;
  i = p;
  j = q;
  k = 0;
  while (i < q && j < r) {
    if (v[i] < v[j]) {
      w[k] = v[i];
      i++;
    }
    else {
      w[k] = v[j];
      j++;
    }
    k++;
  }
  while (i < q) {
    w[k] = v[i];
    i++;
    k++;
  }
  while (j < r) {
    w[k] = v[j];
    j++;
    k++;
  }
  for (i = p; i < r; i++)
    v[i] = w[i-p];
}

void mergesort(int p, int r, NumericVector v, NumericVector aux)
{
  int q;
  if (p < r - 1) {
    q = (p + r) / 2;
    mergesort(p, q, v,aux);
    mergesort(q, r, v,aux);
    intercal(p, q, r, v,aux);
  }
}

// [[Rcpp::export]]
NumericVector sort_merge(NumericVector vetor) {
  Rcpp::NumericVector res = Rcpp::clone(vetor);
  Rcpp::NumericVector aux = Rcpp::clone(vetor);
  int n = res.size();
  mergesort(0,n,res,aux);
  return res;}

Source file example for some sorting algorithms written in C++ via RCPP to R implimentation

#include <Rcpp.h>
# include<algorithm>
using namespace Rcpp;


/*
 * This file contains some algorithms of sorting written in C++ & implimented in RCPP .
 * All these algorithms are not performed as well as sort inner algorithm 
 * used in R except of the sort_stl function .
 *   

 * get pdf: source      
 *                 MACHERKI M.E 
 *                  12/02/2016 
 */


// [[Rcpp::export]]
NumericVector sort_insert(NumericVector A) {
  int i,j;
  double x;
  for(i=1; i<A.size();i++){
    x=A[i];j=i-1;
    while((j>=0) & (A[j]>x)){ //without using swapping
      A[j+1]=A[j];
      j=j-1;
    }
  A[j+1]=x;
  
  }
  return A;
}
 
 // [[Rcpp::export]]
 NumericVector sort_bubble(NumericVector A) { 
   int n=A.size();
   int swap=1;
   double tmp;
   for(;;){
     if(swap==0)break;
     swap=0;
     for(int i=1;i<n;i++){
       if(A[i-1]>A[i]){
         tmp=A[i];A[i]=A[i-1];A[i-1]=tmp;
         swap=1;
       }
     }
   }
   return A;}

// [[Rcpp::export]]
NumericVector sort_selection(NumericVector A) { 
  int i,j;
  double tmp;
  for(j=0;j<A.size();j++){
    int imin=j;
    for(i=j+1;i<A.size();i++){
      if(A[i]<A[imin])imin=i;
    }
  if(imin!=j){
   tmp=A[j];A[j]= A[imin];A[imin]=tmp;
  }
  
  }
  return A;}
  
 

   // [[Rcpp::export]]
 NumericVector gaps( int sz ) { 
   NumericVector result;
   result.push_back(701);
   result.push_back(301);
   result.push_back(132);
   result.push_back(57);
   result.push_back(23);
   result.push_back(10);
   result.push_back(4);
   result.push_back(1);
   return result;}

// [[Rcpp::export]]
NumericVector sort_shell(NumericVector A) { 
  double temp=0;
  int N =A.size();
  int i,j,gap;
  NumericVector tacuda=gaps(0);
  int n=tacuda.size();
  for(int k=n-1;k>0;k--){
    gap=tacuda[k];
  for( i=gap;i<N;i++){
    temp=A[i];
    for( j=i;(j>=gap)&(A[j-gap]>temp);j-=gap){
      A[j]=A[j-gap];
    }
    A[j]=temp;
    
    }
    
  }
  return A;}


  
  
// This function is faster then R sort function !
// [[Rcpp::export]]
NumericVector sort_stl(NumericVector A) { 
  
  NumericVector tmp=clone(A);
  std::sort(tmp.begin(),tmp.end());
  return tmp;
}
  
  
  // [[Rcpp::export]]
 void Quick(NumericVector arr,int left,int right) { 
  int i=left;int j=right;
  double tmp;
  double pivot=arr[(left+right)/2];
  /*partition*/
  while(i<=j){
    while(arr[i]<pivot)
      i++;
    while(arr[j]>pivot)
      j--;
      if(i<=j){
        tmp=arr[i];
        arr[i]=arr[j];
        arr[j]=tmp;
        i++;
        j--;
        
      }
    }
  /*recursion*/
  if(left<j)
    Quick(arr,left,j);
  if(i<right)
    Quick(arr,i,right);
}
    
    
    
    /*
     * This function is really comparable with the inner sort used in R
     * even the code is sample , the algorithm is good.
     */
    
    
    // [[Rcpp::export]]
    NumericVector sort_quick(NumericVector A) {
      NumericVector tmp=clone(A);
    Quick(tmp,0,tmp.size()-1); //just starting from the middle of the vector
      return tmp;
    }
      
  
  
  
  


// R call

/*** R

###not rapid methods, adapted to small sample size
x<-rnorm(100)
sort_insert(x)
sort (x)
sort_selection(x)
sort_bubble(x)
identical(sort_stl(x),sort (x))## the purpose of C++ integration  
identical(sort_quick(x),sort (x))
identical(sort_insert(x),sort (x))
identical(sort_bubble(x),sort (x))
identical(sort_selection(x),sort (x))
identical(sort_shell(x),sort (x))
x<-rnorm(1000000)    ##large numeric vector
system.time(sort(x))
system.time(sort_quick(x)) ## as R sort function
system.time(sort_stl(x)) ## two time faster the R sort!!!    


  */