1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2011 - DIGITEO - Cedric DELAMARRE
4 *
5 * Copyright (C) 2012 - 2016 - Scilab Enterprises
6 *
7 * This file is hereby licensed under the terms of the GNU GPL v2.0,
8 * pursuant to article 5.3.4 of the CeCILL v.2.1.
9 * This file was originally licensed under the terms of the CeCILL v2.1,
10 * and continues to be available under such terms.
11 * For more information, see the COPYING file which you should have received
12 * along with this program.
13 *
14 */
15 /*--------------------------------------------------------------------------*/
16
17 #include "interpolation_gw.hxx"
18 #include "function.hxx"
19 #include "double.hxx"
20 #include "string.hxx"
21
22 extern "C"
23 {
24 #include "sci_malloc.h"
25 #include "localization.h"
26 #include "Scierror.h"
27 #include "interpolation_functions.h"
28 #include "interpolation.h"
29 }
30 /*--------------------------------------------------------------------------*/
31
sci_splin(types::typed_list & in,int _iRetCount,types::typed_list & out)32 types::Function::ReturnValue sci_splin(types::typed_list &in, int _iRetCount, types::typed_list &out)
33 {
34 // input
35 types::Double* pDblX = NULL;
36 types::Double* pDblY = NULL;
37 types::Double* pDblDer = NULL;
38
39 // output
40 types::Double* pDblOut = NULL;
41
42 int iType = 0; // default value = not_a_knot
43 int one = 1;
44 int iSize = 0;
45
46 double* rwork1 = NULL;
47 double* rwork2 = NULL;
48 double* rwork3 = NULL;
49 double* rwork4 = NULL;
50
51 // *** check the minimal number of input args. ***
52 if (in.size() < 2 || in.size() > 4)
53 {
54 Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "splin", 2, 4);
55 return types::Function::Error;
56 }
57
58 // *** check number of output args according the methode. ***
59 if (_iRetCount > 1)
60 {
61 Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "splin", 1);
62 return types::Function::Error;
63 }
64
65 // *** check type of input args and get it. ***
66 // x
67 if (in[0]->isDouble() == false)
68 {
69 Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "splin", 1);
70 return types::Function::Error;
71 }
72
73 pDblX = in[0]->getAs<types::Double>();
74 iSize = pDblX->getSize();
75
76 if (pDblX->isComplex())
77 {
78 Scierror(999, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), "splin", 1);
79 return types::Function::Error;
80 }
81
82 if (iSize < 2)
83 {
84 Scierror(999, _("%s: Wrong size for input argument #%d : At least a size of 2 expected.\n"), "splin", 1);
85 return types::Function::Error;
86 }
87
88 if (good_order(pDblX->get(), iSize) == false) /* verify strict increasing abscissae */
89 {
90 Scierror(999, _("%s: Wrong value for input argument #%d: Not (strictly) increasing or +-inf detected.\n"), "splin", 1);
91 return types::Function::Error;
92 }
93
94 // y
95 if (in[1]->isDouble() == false)
96 {
97 Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "splin", 2);
98 return types::Function::Error;
99 }
100
101 pDblY = in[1]->getAs<types::Double>();
102
103 if (pDblY->isComplex())
104 {
105 Scierror(999, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), "splin", 2);
106 return types::Function::Error;
107 }
108
109 if ( pDblX->getCols() != pDblY->getCols() ||
110 pDblX->getRows() != pDblY->getRows() ||
111 (pDblX->getCols() != 1 && pDblX->getRows() != 1))
112 {
113 Scierror(999, _("%s: Wrong size for input arguments #%d and #%d: Vector of same size expected.\n"), "splin", 1, 2);
114 return types::Function::Error;
115 }
116
117 if (in.size() > 2)
118 {
119 if (in[2]->isString() == false)
120 {
121 Scierror(999, _("%s: Wrong type for input argument #%d : string expected.\n"), "splin", 3);
122 return types::Function::Error;
123 }
124
125 wchar_t* wcsType = in[2]->getAs<types::String>()->get(0);
126
127 if (wcscmp(wcsType, L"not_a_knot") == 0)
128 {
129 iType = 0;
130 }
131 else if (wcscmp(wcsType, L"natural") == 0)
132 {
133 iType = 1;
134 }
135 else if (wcscmp(wcsType, L"clamped") == 0)
136 {
137 iType = 2;
138 }
139 else if (wcscmp(wcsType, L"periodic") == 0)
140 {
141 iType = 3;
142 }
143 else if (wcscmp(wcsType, L"fast") == 0)
144 {
145 iType = 4;
146 }
147 else if (wcscmp(wcsType, L"fast_periodic") == 0)
148 {
149 iType = 5;
150 }
151 else if (wcscmp(wcsType, L"monotone") == 0)
152 {
153 iType = 6;
154 }
155 else // undefined
156 {
157 char* pstType = wide_string_to_UTF8(wcsType);
158 Scierror(999, _("%s: Wrong values for input argument #%d : '%s' is an unknown '%s' type.\n"), "splin", 3, pstType, "spline");
159 FREE(pstType);
160 return types::Function::Error;
161 }
162
163 if (iType == 2)
164 {
165 if (in.size() != 4)
166 {
167 Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "splin", 4);
168 return types::Function::Error;
169 }
170
171 if (in[3]->isDouble() == false)
172 {
173 Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "splin", 4);
174 return types::Function::Error;
175 }
176
177 pDblDer = in[3]->getAs<types::Double>();
178
179 if (pDblDer->getSize() != 2)
180 {
181 Scierror(999, _("%s: Wrong size for input argument #%d : A matrix of size 2 expected.\n"), "splin", 4);
182 return types::Function::Error;
183 }
184 }
185 else if (in.size() == 4)
186 {
187 Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "splin", 3);
188 return types::Function::Error;
189 }
190 }
191
192 // verify y(1) = y(n) for periodic splines
193 if ((iType == 3 || iType == 5) && pDblY->get(0) != pDblY->get(pDblY->getSize() - 1))
194 {
195 Scierror(999, _("%s: Wrong value for periodic spline %s: Must be equal to %s.\n"), "spline", "y(1)", "y(n)");
196 return types::Function::Error;
197 }
198
199 // *** Perform operation. ***
200 pDblOut = new types::Double(pDblX->getRows(), pDblX->getCols());
201
202 switch (iType)
203 {
204 case 6:
205 C2F(dpchim)(&iSize, pDblX->get(), pDblY->get(), pDblOut->get(), &one);
206 case 5:
207 case 4:
208 C2F(derivd)(pDblX->get(), pDblY->get(), pDblOut->get(), &iSize, &one, &iType);
209 break;
210 break;
211 case 3:
212 case 2:
213 case 1:
214 case 0:
215 {
216 rwork1 = new double[iSize];
217 rwork2 = new double[iSize - 1];
218 rwork3 = new double[iSize - 1];
219 rwork4 = rwork1;
220
221 if (iType == 2)
222 {
223 pDblOut->set(0, pDblDer->get(0));
224 pDblOut->set(iSize - 1, pDblDer->get(1));
225 }
226
227 if (iType == 3)
228 {
229 rwork4 = new double[iSize - 1];
230 }
231
232 C2F(splinecub)(pDblX->get(), pDblY->get(), pDblOut->get(), &iSize, &iType, rwork1, rwork2, rwork3, rwork4);
233
234 delete[] rwork1;
235 delete[] rwork2;
236 delete[] rwork3;
237 if (iType == 3)
238 {
239 delete[] rwork4;
240 }
241
242 break;
243 }
244 }
245
246 // *** Return result in Scilab. ***
247 out.push_back(pDblOut);
248
249 return types::Function::OK;
250 }
251
252