htswanalysis/MACS/lib/gsl/gsl-1.11/sort/test_source.c

   1 /* sort/test_source.c
   2  *
   3  * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Thomas Walter, Brian Gough
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU General Public License as published by
   7  * the Free Software Foundation; either version 3 of the License, or (at
   8  * your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this program; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18  */
  19
  20 void TYPE (test_sort_vector) (size_t N, size_t stride);
  21 void FUNCTION (my, initialize) (TYPE (gsl_vector) * v);
  22 void FUNCTION (my, randomize) (TYPE (gsl_vector) * v);
  23 int FUNCTION (my, check) (TYPE (gsl_vector) * data, TYPE (gsl_vector) * orig);
  24 int FUNCTION (my, pcheck) (gsl_permutation * p, TYPE (gsl_vector) * data, TYPE (gsl_vector) * orig);
  25 int FUNCTION (my, scheck) (BASE * x, size_t k, TYPE (gsl_vector) * data);
  26 int FUNCTION (my, lcheck) (BASE * x, size_t k, TYPE (gsl_vector) * data);
  27 int FUNCTION (my, sicheck) (size_t * p, size_t k, gsl_permutation * perm,
  28                             TYPE (gsl_vector) * data);
  29 int FUNCTION (my, licheck) (size_t * p, size_t k, gsl_permutation * perm,
  30                             TYPE (gsl_vector) * data);
  31
  32 void
  33 TYPE (test_sort_vector) (size_t N, size_t stride)
  34 {
  35   int status;
  36   size_t  k = N/2;
  37
  38   TYPE (gsl_block) * b1 = FUNCTION (gsl_block, calloc) (N * stride);
  39   TYPE (gsl_block) * b2 = FUNCTION (gsl_block, calloc) (N * stride);
  40   TYPE (gsl_block) * b3 = FUNCTION (gsl_block, calloc) (N * stride);
  41
  42   TYPE (gsl_vector) * orig = FUNCTION (gsl_vector, alloc_from_block) (b1, 0, N, stride);
  43   TYPE (gsl_vector) * data = FUNCTION (gsl_vector, alloc_from_block) (b2, 0, N, stride);
  44   TYPE (gsl_vector) * data2 = FUNCTION (gsl_vector, alloc_from_block) (b3, 0, N, stride);
  45
  46   BASE * small = malloc(k * sizeof(BASE));
  47   BASE * large = malloc(k * sizeof(BASE));
  48   size_t * index = malloc(k * sizeof(size_t));
  49
  50   gsl_permutation *p = gsl_permutation_alloc (N);
  51
  52   FUNCTION (my, initialize) (orig);
  53
  54   /* Already sorted */
  55   FUNCTION (gsl_vector, memcpy) (data, orig);
  56
  57   status = FUNCTION (gsl_sort_vector, index) (p, data);
  58   status |= FUNCTION (my, pcheck) (p, data, orig);
  59   gsl_test (status, "indexing " NAME (gsl_vector) ", n = %u, stride = %u, ordered", N, stride);
  60
  61   TYPE (gsl_sort_vector) (data);
  62   status = FUNCTION (my, check) (data, orig);
  63   gsl_test (status, "sorting, " NAME (gsl_vector) ", n = %u, stride = %u, ordered", N, stride);
  64
  65   FUNCTION (gsl_sort_vector, smallest) (small, k, data);
  66   status = FUNCTION (my, scheck) (small, k, orig);
  67   gsl_test (status, "smallest, " NAME (gsl_vector) ", n = %u, stride = %u, ordered", N, stride);
  68
  69   FUNCTION (gsl_sort_vector, largest) (large, k, data);
  70   status = FUNCTION (my, lcheck) (large, k, orig);
  71   gsl_test (status, "largest, " NAME (gsl_vector) ", n = %u, stride = %u, ordered", N, stride);
  72
  73   FUNCTION (gsl_sort_vector, smallest_index) (index, k, data);
  74   status = FUNCTION (my, sicheck) (index, k, p, data);
  75   gsl_test (status, "smallest index, " NAME (gsl_vector) ", n = %u, stride = %u, ordered", N, stride);
  76
  77   FUNCTION (gsl_sort_vector, largest_index) (index, k, data);
  78   status = FUNCTION (my, licheck) (index, k, p, data);
  79   gsl_test (status, "largest index, " NAME (gsl_vector) ", n = %u, stride = %u, ordered", N, stride);
  80
  81   /* Reverse the data */
  82
  83   FUNCTION (gsl_vector, memcpy) (data, orig);
  84   FUNCTION (gsl_vector, reverse) (data);
  85
  86   status = FUNCTION (gsl_sort_vector, index) (p, data);
  87   status |= FUNCTION (my, pcheck) (p, data, orig);
  88   gsl_test (status, "indexing " NAME (gsl_vector) ", n = %u, stride = %u, reversed", N, stride);
  89
  90   TYPE (gsl_sort_vector) (data);
  91   status = FUNCTION (my, check) (data, orig);
  92   gsl_test (status, "sorting, " NAME (gsl_vector) ", n = %u, stride = %u, reversed", N, stride);
  93
  94   FUNCTION (gsl_vector, memcpy) (data, orig);
  95   FUNCTION (gsl_vector, reverse) (data);
  96
  97   FUNCTION (gsl_sort_vector, smallest) (small, k, data);
  98   status = FUNCTION (my, scheck) (small, k, orig);
  99   gsl_test (status, "smallest, " NAME (gsl_vector) ", n = %u, stride = %u, reversed", N, stride);
 100
 101   FUNCTION (gsl_sort_vector, largest) (large, k, data);
 102   status = FUNCTION (my, lcheck) (large, k, orig);
 103   gsl_test (status, "largest, " NAME (gsl_vector) ", n = %u, stride = %u, reversed", N, stride);
 104
 105   FUNCTION (gsl_sort_vector, smallest_index) (index, k, data);
 106   status = FUNCTION (my, sicheck) (index, k, p, data);
 107   gsl_test (status, "smallest index, " NAME (gsl_vector) ", n = %u, stride = %u, reversed", N, stride);
 108
 109   FUNCTION (gsl_sort_vector, largest_index) (index, k, data);
 110   status = FUNCTION (my, licheck) (index, k, p, data);
 111   gsl_test (status, "largest index, " NAME (gsl_vector) ", n = %u, stride = %u, reversed", N, stride);
 112
 113   /* Perform some shuffling */
 114
 115   FUNCTION (gsl_vector, memcpy) (data, orig);
 116   FUNCTION (my, randomize) (data);
 117   FUNCTION (gsl_vector, memcpy) (data2, data);
 118
 119   status = FUNCTION (gsl_sort_vector, index) (p, data);
 120   status |= FUNCTION (my, pcheck) (p, data, orig);
 121   gsl_test (status, "indexing " NAME (gsl_vector) ", n = %u, stride = %u, randomized", N, stride);
 122
 123   TYPE (gsl_sort_vector) (data);
 124   status = FUNCTION (my, check) (data, orig);
 125   gsl_test (status, "sorting, " NAME (gsl_vector) ", n = %u, stride = %u, randomized", N, stride);
 126
 127   FUNCTION (gsl_vector, memcpy) (data, data2);
 128
 129   FUNCTION (gsl_sort_vector, smallest) (small, k, data);
 130   status = FUNCTION (my, scheck) (small, k, orig);
 131   gsl_test (status, "smallest, " NAME (gsl_vector) ", n = %u, stride = %u, randomized", N, stride);
 132
 133   FUNCTION (gsl_sort_vector, largest) (large, k, data);
 134   status = FUNCTION (my, lcheck) (large, k, orig);
 135   gsl_test (status, "largest, " NAME (gsl_vector) ", n = %u, stride = %u, randomized", N, stride);
 136
 137   FUNCTION (gsl_sort_vector, smallest_index) (index, k, data);
 138   status = FUNCTION (my, sicheck) (index, k, p, data);
 139   gsl_test (status, "smallest index, " NAME (gsl_vector) ", n = %u, stride = %u, randomized", N, stride);
 140
 141   FUNCTION (gsl_sort_vector, largest_index) (index, k, data);
 142   status = FUNCTION (my, licheck) (index, k, p, data);
 143   gsl_test (status, "largest index, " NAME (gsl_vector) ", n = %u, stride = %u, randomized", N, stride);
 144
 145   FUNCTION (gsl_vector, free) (orig);
 146   FUNCTION (gsl_vector, free) (data);
 147   FUNCTION (gsl_vector, free) (data2);
 148   FUNCTION (gsl_block, free) (b1);
 149   FUNCTION (gsl_block, free) (b2);
 150   FUNCTION (gsl_block, free) (b3);
 151   gsl_permutation_free (p);
 152   free (small);
 153   free (large);
 154   free (index);
 155 }
 156
 157
 158 void
 159 FUNCTION (my, initialize) (TYPE (gsl_vector) * v)
 160 {
 161   size_t i;
 162   ATOMIC k = 0;
 163   volatile ATOMIC kk;
 164
 165   /* Must be sorted initially */
 166
 167   for (i = 0; i < v->size; i++)
 168     {
 169       kk = k;
 170       k++;
 171       /* Prevent overflow */
 172       if (k < kk) k = kk;
 173       FUNCTION (gsl_vector, set) (v, i, k);
 174     }
 175 }
 176
 177 void
 178 FUNCTION (my, randomize) (TYPE (gsl_vector) * v)
 179 {
 180   size_t i;
 181
 182   for (i = 0; i < v->size; i++)
 183     {
 184       size_t j = urand (v->size);
 185       FUNCTION (gsl_vector, swap_elements) (v, i, j);
 186     }
 187 }
 188
 189 int
 190 FUNCTION (my, check) (TYPE (gsl_vector) * data, TYPE (gsl_vector) * orig)
 191 {
 192   size_t i;
 193
 194   for (i = 0; i < data->size; i++)
 195     {
 196       if (FUNCTION (gsl_vector, get) (data, i) != FUNCTION (gsl_vector, get) (orig, i))
 197         {
 198 #if DUMP_ERROR
 199           size_t j;
 200           for (j = 0 ; j < data->size; j++) {
 201             printf("%u: " OUT_FORMAT " " OUT_FORMAT " %c\n", j,
 202                    FUNCTION (gsl_vector, get) (data, j),
 203                    FUNCTION (gsl_vector, get) (orig, j),
 204                    (i == j) ? '*' : ' ');
 205           }
 206 #endif
 207
 208           return GSL_FAILURE;
 209         }
 210     }
 211
 212   return GSL_SUCCESS;
 213 }
 214
 215 int
 216 FUNCTION (my, pcheck) (gsl_permutation * p, TYPE (gsl_vector) * data, TYPE (gsl_vector) * orig)
 217 {
 218   size_t i;
 219
 220   for (i = 0; i < p->size; i++)
 221     {
 222       if (FUNCTION (gsl_vector, get) (data, p->data[i]) != FUNCTION (gsl_vector, get) (orig, i))
 223         {
 224           return GSL_FAILURE;
 225         }
 226     }
 227
 228   return GSL_SUCCESS;
 229 }
 230
 231 int
 232 FUNCTION (my, scheck) (BASE * x, size_t k, TYPE (gsl_vector) * data)
 233 {
 234   size_t i;
 235
 236   for (i = 0; i < k; i++)
 237     {
 238       if (x[i] != FUNCTION (gsl_vector, get) (data, i))
 239         {
 240           return GSL_FAILURE;
 241         }
 242     }
 243
 244   return GSL_SUCCESS;
 245 }
 246
 247
 248
 249 int
 250 FUNCTION (my, lcheck) (BASE * x, size_t k, TYPE (gsl_vector) * data)
 251 {
 252   size_t i;
 253
 254   for (i = 0; i < k; i++)
 255     {
 256       if (x[i] != FUNCTION (gsl_vector, get) (data, data->size - i - 1))
 257         {
 258           return GSL_FAILURE;
 259         }
 260     }
 261
 262   return GSL_SUCCESS;
 263 }
 264
 265
 266 int
 267 FUNCTION (my, sicheck) (size_t * p1, size_t k, gsl_permutation * p,
 268                         TYPE (gsl_vector) * data)
 269 {
 270   size_t i;
 271
 272   for (i = 0; i < k; i++)
 273     {
 274       if (FUNCTION(gsl_vector,get)(data,p1[i])
 275           != FUNCTION(gsl_vector,get)(data, p->data[i]))
 276         {
 277           return GSL_FAILURE;
 278         }
 279     }
 280
 281   return GSL_SUCCESS;
 282 }
 283
 284 int
 285 FUNCTION (my, licheck) (size_t * p1, size_t k, gsl_permutation * p,
 286                         TYPE (gsl_vector) * data)
 287 {
 288   size_t i;
 289
 290   for (i = 0; i < k; i++)
 291     {
 292       if (FUNCTION(gsl_vector,get)(data,p1[i])
 293           != FUNCTION(gsl_vector,get)(data, p->data[p->size - i - 1]))
 294         {
 295           return GSL_FAILURE;
 296         }
 297     }
 298
 299   return GSL_SUCCESS;
 300 }
 301
 302
 303