File: mlgsl_permut.c

package info (click to toggle)
ocamlgsl 0.3.5-3
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 3,444 kB
  • ctags: 2,901
  • sloc: ml: 7,956; ansic: 6,796; makefile: 303; sh: 87; awk: 13
file content (164 lines) | stat: -rw-r--r-- 4,837 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
/* ocamlgsl - OCaml interface to GSL                        */
/* Copyright () 2002 - Olivier Andrieu                     */
/* distributed under the terms of the GPL version 2         */


#include <gsl/gsl_permutation.h>
#include <gsl/gsl_permute.h>

#include "wrappers.h"
#include "mlgsl_permut.h"

value ml_gsl_permutation_init(value p)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  gsl_permutation_init(&perm_p);
  return Val_unit;
}

value ml_gsl_permutation_valid(value p)
{
  int r;
  GSL_PERMUT_OF_BIGARRAY(p);
  r = gsl_permutation_valid(&perm_p);
  return Val_negbool(r);
}

value ml_gsl_permutation_reverse(value p)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  gsl_permutation_reverse(&perm_p);
  return Val_unit;
}

value ml_gsl_permutation_inverse(value src, value dst)
{
  GSL_PERMUT_OF_BIGARRAY(src);
  GSL_PERMUT_OF_BIGARRAY(dst);
  gsl_permutation_inverse(&perm_dst, &perm_src);
  return Val_unit;
}

value ml_gsl_permutation_next(value p)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  gsl_permutation_next(&perm_p);
  return Val_unit;
}

value ml_gsl_permutation_prev(value p)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  gsl_permutation_prev(&perm_p);
  return Val_unit;
}

value ml_gsl_permute(value p, value arr)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  if(Tag_val(arr) == Double_array_tag)
    gsl_permute(perm_p.data, Double_array_val(arr), 1,
		Double_array_length(arr));
  else
    gsl_permute_long(perm_p.data, (value *)arr, 1, Array_length(arr));
  return Val_unit;
}

value ml_gsl_permute_barr(value p, value arr)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  struct caml_bigarray *barr = Bigarray_val(arr);
  enum caml_bigarray_kind kind = (barr->flags) & BIGARRAY_KIND_MASK ;
  switch(kind){
  case BIGARRAY_FLOAT32:
    gsl_permute_float(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_FLOAT64:
    gsl_permute(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_SINT8:
    gsl_permute_char(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_UINT8:
    gsl_permute_uchar(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_SINT16:
    gsl_permute_short(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_UINT16:
    gsl_permute_ushort(perm_p.data, barr->data, 1, barr->dim[0]); break;
#ifdef ARCH_SIXTYFOUR
  case BIGARRAY_INT64:
#else
  case BIGARRAY_INT32:
#endif
  case BIGARRAY_CAML_INT:
  case BIGARRAY_NATIVE_INT:
    gsl_permute_long(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_COMPLEX32:
    gsl_permute_complex_float(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_COMPLEX64:
    gsl_permute_complex(perm_p.data, barr->data, 1, barr->dim[0]); break;
  default: 
    GSL_ERROR("data type not supported", GSL_EUNIMPL);
  }
  return Val_unit;
}

value ml_gsl_permute_complex(value p, value arr)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  gsl_permute_complex(perm_p.data, Double_array_val(arr), 1, 
		      Double_array_length(arr)/2);
  return Val_unit;
}

value ml_gsl_permute_inverse(value p, value arr)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  if(Tag_val(arr) == Double_array_tag)
    gsl_permute_inverse(perm_p.data, Double_array_val(arr), 1,
			Double_array_length(arr));
  else
    gsl_permute_long_inverse(perm_p.data, (value *)arr, 1, Array_length(arr));
  return Val_unit;
}

value ml_gsl_permute_inverse_barr(value p, value arr)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  struct caml_bigarray *barr = Bigarray_val(arr);
  enum caml_bigarray_kind kind = (barr->flags) & BIGARRAY_KIND_MASK ;
  switch(kind){
  case BIGARRAY_FLOAT32:
    gsl_permute_float_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_FLOAT64:
    gsl_permute_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_SINT8:
    gsl_permute_char_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_UINT8:
    gsl_permute_uchar_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_SINT16:
    gsl_permute_short_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_UINT16:
    gsl_permute_ushort_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
#ifdef ARCH_SIXTYFOUR
  case BIGARRAY_INT64:
#else
  case BIGARRAY_INT32:
#endif
  case BIGARRAY_CAML_INT:
  case BIGARRAY_NATIVE_INT:
    gsl_permute_long_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_COMPLEX32:
    gsl_permute_complex_float_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
  case BIGARRAY_COMPLEX64:
    gsl_permute_complex_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break;
  default:
    GSL_ERROR("data type not supported", GSL_EUNIMPL);
  }
  return Val_unit;
}

value ml_gsl_permute_inverse_complex(value p, value arr)
{
  GSL_PERMUT_OF_BIGARRAY(p);
  gsl_permute_complex_inverse(perm_p.data, Double_array_val(arr), 1, 
			      Double_array_length(arr)/2);
  return Val_unit;
}