~ubuntu-branches/ubuntu/quantal/orpie/quantal

« back to all changes in this revision

Viewing changes to gsl/mlgsl_permut.c

  • Committer: Bazaar Package Importer
  • Author(s): Uwe Steinmann
  • Date: 2004-09-20 14:18:45 UTC
  • Revision ID: james.westby@ubuntu.com-20040920141845-j092sbrg4hd0nfsf
Tags: upstream-1.4.1
Import upstream version 1.4.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/* ocamlgsl - OCaml interface to GSL                        */
 
2
/* Copyright (�) 2002 - Olivier Andrieu                     */
 
3
/* distributed under the terms of the GPL version 2         */
 
4
 
 
5
 
 
6
#include <gsl/gsl_permutation.h>
 
7
#include <gsl/gsl_permute.h>
 
8
 
 
9
#include "wrappers.h"
 
10
#include "mlgsl_error.h"
 
11
#include "mlgsl_permut.h"
 
12
 
 
13
value ml_gsl_permutation_init(value p)
 
14
{
 
15
  GSL_PERMUT_OF_BIGARRAY(p);
 
16
  gsl_permutation_init(&perm_p);
 
17
  return Val_unit;
 
18
}
 
19
 
 
20
value ml_gsl_permutation_valid(value p)
 
21
{
 
22
  int r;
 
23
  GSL_PERMUT_OF_BIGARRAY(p);
 
24
  r = gsl_permutation_valid(&perm_p);
 
25
  return Val_negbool(r);
 
26
}
 
27
 
 
28
value ml_gsl_permutation_reverse(value p)
 
29
{
 
30
  GSL_PERMUT_OF_BIGARRAY(p);
 
31
  gsl_permutation_reverse(&perm_p);
 
32
  return Val_unit;
 
33
}
 
34
 
 
35
value ml_gsl_permutation_inverse(value src, value dst)
 
36
{
 
37
  GSL_PERMUT_OF_BIGARRAY(src);
 
38
  GSL_PERMUT_OF_BIGARRAY(dst);
 
39
  gsl_permutation_inverse(&perm_dst, &perm_src);
 
40
  return Val_unit;
 
41
}
 
42
 
 
43
value ml_gsl_permutation_next(value p)
 
44
{
 
45
  GSL_PERMUT_OF_BIGARRAY(p);
 
46
  gsl_permutation_next(&perm_p);
 
47
  return Val_unit;
 
48
}
 
49
 
 
50
value ml_gsl_permutation_prev(value p)
 
51
{
 
52
  GSL_PERMUT_OF_BIGARRAY(p);
 
53
  gsl_permutation_prev(&perm_p);
 
54
  return Val_unit;
 
55
}
 
56
 
 
57
value ml_gsl_permute(value p, value arr)
 
58
{
 
59
  GSL_PERMUT_OF_BIGARRAY(p);
 
60
  if(Tag_val(arr) == Double_array_tag)
 
61
    gsl_permute(perm_p.data, Double_array_val(arr), 1,
 
62
                Double_array_length(arr));
 
63
  else
 
64
    gsl_permute_long(perm_p.data, (value *)arr, 1, Array_length(arr));
 
65
  return Val_unit;
 
66
}
 
67
 
 
68
value ml_gsl_permute_barr(value p, value arr)
 
69
{
 
70
  GSL_PERMUT_OF_BIGARRAY(p);
 
71
  struct caml_bigarray *barr = Bigarray_val(arr);
 
72
  enum caml_bigarray_kind kind = (barr->flags) & BIGARRAY_KIND_MASK ;
 
73
  switch(kind){
 
74
  case BIGARRAY_FLOAT32:
 
75
    gsl_permute_float(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
76
  case BIGARRAY_FLOAT64:
 
77
    gsl_permute(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
78
  case BIGARRAY_SINT8:
 
79
    gsl_permute_char(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
80
  case BIGARRAY_UINT8:
 
81
    gsl_permute_uchar(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
82
  case BIGARRAY_SINT16:
 
83
    gsl_permute_short(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
84
  case BIGARRAY_UINT16:
 
85
    gsl_permute_ushort(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
86
#ifdef ARCH_SIXTYFOUR
 
87
  case BIGARRAY_INT64:
 
88
#else
 
89
  case BIGARRAY_INT32:
 
90
#endif
 
91
  case BIGARRAY_CAML_INT:
 
92
  case BIGARRAY_NATIVE_INT:
 
93
    gsl_permute_long(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
94
  case BIGARRAY_COMPLEX32:
 
95
    gsl_permute_complex_float(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
96
  case BIGARRAY_COMPLEX64:
 
97
    gsl_permute_complex(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
98
  default: 
 
99
    MLGSLexn("data type not supported", GSL_EUNIMPL);
 
100
  }
 
101
  return Val_unit;
 
102
}
 
103
 
 
104
value ml_gsl_permute_complex(value p, value arr)
 
105
{
 
106
  GSL_PERMUT_OF_BIGARRAY(p);
 
107
  gsl_permute_complex(perm_p.data, Double_array_val(arr), 1, 
 
108
                      Double_array_length(arr)/2);
 
109
  return Val_unit;
 
110
}
 
111
 
 
112
value ml_gsl_permute_inverse(value p, value arr)
 
113
{
 
114
  GSL_PERMUT_OF_BIGARRAY(p);
 
115
  if(Tag_val(arr) == Double_array_tag)
 
116
    gsl_permute_inverse(perm_p.data, Double_array_val(arr), 1,
 
117
                        Double_array_length(arr));
 
118
  else
 
119
    gsl_permute_long_inverse(perm_p.data, (value *)arr, 1, Array_length(arr));
 
120
  return Val_unit;
 
121
}
 
122
 
 
123
value ml_gsl_permute_inverse_barr(value p, value arr)
 
124
{
 
125
  GSL_PERMUT_OF_BIGARRAY(p);
 
126
  struct caml_bigarray *barr = Bigarray_val(arr);
 
127
  enum caml_bigarray_kind kind = (barr->flags) & BIGARRAY_KIND_MASK ;
 
128
  switch(kind){
 
129
  case BIGARRAY_FLOAT32:
 
130
    gsl_permute_float_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
131
  case BIGARRAY_FLOAT64:
 
132
    gsl_permute_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
133
  case BIGARRAY_SINT8:
 
134
    gsl_permute_char_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
135
  case BIGARRAY_UINT8:
 
136
    gsl_permute_uchar_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
137
  case BIGARRAY_SINT16:
 
138
    gsl_permute_short_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
139
  case BIGARRAY_UINT16:
 
140
    gsl_permute_ushort_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
141
#ifdef ARCH_SIXTYFOUR
 
142
  case BIGARRAY_INT64:
 
143
#else
 
144
  case BIGARRAY_INT32:
 
145
#endif
 
146
  case BIGARRAY_CAML_INT:
 
147
  case BIGARRAY_NATIVE_INT:
 
148
    gsl_permute_long_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
149
  case BIGARRAY_COMPLEX32:
 
150
    gsl_permute_complex_float_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
151
  case BIGARRAY_COMPLEX64:
 
152
    gsl_permute_complex_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
 
153
  default:
 
154
    MLGSLexn("data type not supported", GSL_EUNIMPL);
 
155
  }
 
156
  return Val_unit;
 
157
}
 
158
 
 
159
value ml_gsl_permute_inverse_complex(value p, value arr)
 
160
{
 
161
  GSL_PERMUT_OF_BIGARRAY(p);
 
162
  gsl_permute_complex_inverse(perm_p.data, Double_array_val(arr), 1, 
 
163
                              Double_array_length(arr)/2);
 
164
  return Val_unit;
 
165
}