1 ////////////////////////////////////////////////////////////////////////
2 //
3 // Copyright (C) 1996-2021 The Octave Project Developers
4 //
5 // See the file COPYRIGHT.md in the top-level directory of this
6 // distribution or <https://octave.org/copyright/>.
7 //
8 // This file is part of Octave.
9 //
10 // Octave is free software: you can redistribute it and/or modify it
11 // under the terms of the GNU General Public License as published by
12 // the Free Software Foundation, either version 3 of the License, or
13 // (at your option) any later version.
14 //
15 // Octave is distributed in the hope that it will be useful, but
16 // WITHOUT ANY WARRANTY; without even the implied warranty of
17 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 // GNU General Public License for more details.
19 //
20 // You should have received a copy of the GNU General Public License
21 // along with Octave; see the file COPYING. If not, see
22 // <https://www.gnu.org/licenses/>.
23 //
24 ////////////////////////////////////////////////////////////////////////
25
26 #if defined (HAVE_CONFIG_H)
27 # include "config.h"
28 #endif
29
30 #include <istream>
31 #include <ostream>
32
33 #include "lo-ieee.h"
34 #include "lo-specfun.h"
35 #include "lo-mappers.h"
36
37 #include "mxarray.h"
38 #include "ovl.h"
39 #include "oct-hdf5.h"
40 #include "oct-stream.h"
41 #include "ops.h"
42 #include "ov-complex.h"
43 #include "ov-base.h"
44 #include "ov-base-scalar.h"
45 #include "ov-base-scalar.cc"
46 #include "ov-flt-cx-mat.h"
47 #include "ov-float.h"
48 #include "ov-flt-complex.h"
49 #include "errwarn.h"
50 #include "pr-output.h"
51 #include "ops.h"
52
53 #include "ls-oct-text.h"
54 #include "ls-hdf5.h"
55
56 // Prevent implicit instantiations on some systems (Windows, others?)
57 // that can lead to duplicate definitions of static data members.
58
59 extern template class OCTINTERP_API octave_base_scalar<float>;
60
61 template class octave_base_scalar<FloatComplex>;
62
63 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_complex,
64 "float complex scalar", "single");
65
66 octave_base_value *
try_narrowing_conversion(void)67 octave_float_complex::try_narrowing_conversion (void)
68 {
69 octave_base_value *retval = nullptr;
70
71 float im = scalar.imag ();
72
73 if (im == 0.0)
74 retval = new octave_float_scalar (scalar.real ());
75
76 return retval;
77 }
78
79 octave_value
do_index_op(const octave_value_list & idx,bool resize_ok)80 octave_float_complex::do_index_op (const octave_value_list& idx, bool resize_ok)
81 {
82 // FIXME: this doesn't solve the problem of
83 //
84 // a = i; a([1,1], [1,1], [1,1])
85 //
86 // and similar constructions. Hmm...
87
88 // FIXME: using this constructor avoids narrowing the
89 // 1x1 matrix back to a scalar value. Need a better solution
90 // to this problem.
91
92 octave_value tmp (new octave_float_complex_matrix (float_complex_matrix_value ()));
93
94 return tmp.do_index_op (idx, resize_ok);
95 }
96
97 double
double_value(bool force_conversion) const98 octave_float_complex::double_value (bool force_conversion) const
99 {
100 if (! force_conversion)
101 warn_implicit_conversion ("Octave:imag-to-real",
102 "complex scalar", "real scalar");
103
104 return scalar.real ();
105 }
106
107 float
float_value(bool force_conversion) const108 octave_float_complex::float_value (bool force_conversion) const
109 {
110 if (! force_conversion)
111 warn_implicit_conversion ("Octave:imag-to-real",
112 "complex scalar", "real scalar");
113
114 return scalar.real ();
115 }
116
117 Matrix
matrix_value(bool force_conversion) const118 octave_float_complex::matrix_value (bool force_conversion) const
119 {
120 Matrix retval;
121
122 if (! force_conversion)
123 warn_implicit_conversion ("Octave:imag-to-real",
124 "complex scalar", "real matrix");
125
126 retval = Matrix (1, 1, scalar.real ());
127
128 return retval;
129 }
130
131 FloatMatrix
float_matrix_value(bool force_conversion) const132 octave_float_complex::float_matrix_value (bool force_conversion) const
133 {
134 FloatMatrix retval;
135
136 if (! force_conversion)
137 warn_implicit_conversion ("Octave:imag-to-real",
138 "complex scalar", "real matrix");
139
140 retval = FloatMatrix (1, 1, scalar.real ());
141
142 return retval;
143 }
144
145 NDArray
array_value(bool force_conversion) const146 octave_float_complex::array_value (bool force_conversion) const
147 {
148 NDArray retval;
149
150 if (! force_conversion)
151 warn_implicit_conversion ("Octave:imag-to-real",
152 "complex scalar", "real matrix");
153
154 retval = NDArray (dim_vector (1, 1), scalar.real ());
155
156 return retval;
157 }
158
159 FloatNDArray
float_array_value(bool force_conversion) const160 octave_float_complex::float_array_value (bool force_conversion) const
161 {
162 FloatNDArray retval;
163
164 if (! force_conversion)
165 warn_implicit_conversion ("Octave:imag-to-real",
166 "complex scalar", "real matrix");
167
168 retval = FloatNDArray (dim_vector (1, 1), scalar.real ());
169
170 return retval;
171 }
172
173 Complex
complex_value(bool) const174 octave_float_complex::complex_value (bool) const
175 {
176 return scalar;
177 }
178
179 FloatComplex
float_complex_value(bool) const180 octave_float_complex::float_complex_value (bool) const
181 {
182 return static_cast<FloatComplex> (scalar);
183 }
184
185 ComplexMatrix
complex_matrix_value(bool) const186 octave_float_complex::complex_matrix_value (bool) const
187 {
188 return ComplexMatrix (1, 1, scalar);
189 }
190
191 FloatComplexMatrix
float_complex_matrix_value(bool) const192 octave_float_complex::float_complex_matrix_value (bool) const
193 {
194 return FloatComplexMatrix (1, 1, scalar);
195 }
196
197 ComplexNDArray
complex_array_value(bool) const198 octave_float_complex::complex_array_value (bool /* force_conversion */) const
199 {
200 return ComplexNDArray (dim_vector (1, 1), scalar);
201 }
202
203 FloatComplexNDArray
float_complex_array_value(bool) const204 octave_float_complex::float_complex_array_value (bool /* force_conversion */) const
205 {
206 return FloatComplexNDArray (dim_vector (1, 1), scalar);
207 }
208
209 octave_value
resize(const dim_vector & dv,bool fill) const210 octave_float_complex::resize (const dim_vector& dv, bool fill) const
211 {
212 if (fill)
213 {
214 FloatComplexNDArray retval (dv, FloatComplex (0));
215
216 if (dv.numel ())
217 retval(0) = scalar;
218
219 return retval;
220 }
221 else
222 {
223 FloatComplexNDArray retval (dv);
224
225 if (dv.numel ())
226 retval(0) = scalar;
227
228 return retval;
229 }
230 }
231
232 octave_value
as_double(void) const233 octave_float_complex::as_double (void) const
234 {
235 return Complex (scalar);
236 }
237
238 octave_value
as_single(void) const239 octave_float_complex::as_single (void) const
240 {
241 return scalar;
242 }
243
244 octave_value
diag(octave_idx_type m,octave_idx_type n) const245 octave_float_complex::diag (octave_idx_type m, octave_idx_type n) const
246 {
247 return
248 FloatComplexDiagMatrix (Array<FloatComplex> (dim_vector (1, 1), scalar),
249 m, n);
250 }
251
252 bool
save_ascii(std::ostream & os)253 octave_float_complex::save_ascii (std::ostream& os)
254 {
255 FloatComplex c = float_complex_value ();
256
257 octave_write_float_complex (os, c);
258
259 os << "\n";
260
261 return true;
262 }
263
264 bool
load_ascii(std::istream & is)265 octave_float_complex::load_ascii (std::istream& is)
266 {
267 scalar = octave_read_value<FloatComplex> (is);
268
269 if (! is)
270 error ("load: failed to load complex scalar constant");
271
272 return true;
273 }
274
275 bool
save_binary(std::ostream & os,bool)276 octave_float_complex::save_binary (std::ostream& os, bool /* save_as_floats */)
277 {
278 char tmp = static_cast<char> (LS_FLOAT);
279 os.write (reinterpret_cast<char *> (&tmp), 1);
280 FloatComplex ctmp = float_complex_value ();
281 os.write (reinterpret_cast<char *> (&ctmp), 8);
282
283 return true;
284 }
285
286 bool
load_binary(std::istream & is,bool swap,octave::mach_info::float_format fmt)287 octave_float_complex::load_binary (std::istream& is, bool swap,
288 octave::mach_info::float_format fmt)
289 {
290 char tmp;
291 if (! is.read (reinterpret_cast<char *> (&tmp), 1))
292 return false;
293
294 FloatComplex ctmp;
295 read_floats (is, reinterpret_cast<float *> (&ctmp),
296 static_cast<save_type> (tmp), 2, swap, fmt);
297
298 if (! is)
299 return false;
300
301 scalar = ctmp;
302 return true;
303 }
304
305 bool
save_hdf5(octave_hdf5_id loc_id,const char * name,bool)306 octave_float_complex::save_hdf5 (octave_hdf5_id loc_id, const char *name,
307 bool /* save_as_floats */)
308 {
309 bool retval = false;
310
311 #if defined (HAVE_HDF5)
312
313 hsize_t dimens[3];
314 hid_t space_hid, type_hid, data_hid;
315 space_hid = type_hid = data_hid = -1;
316
317 space_hid = H5Screate_simple (0, dimens, nullptr);
318 if (space_hid < 0)
319 return false;
320
321 type_hid = hdf5_make_complex_type (H5T_NATIVE_FLOAT);
322 if (type_hid < 0)
323 {
324 H5Sclose (space_hid);
325 return false;
326 }
327 #if defined (HAVE_HDF5_18)
328 data_hid = H5Dcreate (loc_id, name, type_hid, space_hid,
329 octave_H5P_DEFAULT, octave_H5P_DEFAULT, octave_H5P_DEFAULT);
330 #else
331 data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, octave_H5P_DEFAULT);
332 #endif
333 if (data_hid < 0)
334 {
335 H5Sclose (space_hid);
336 H5Tclose (type_hid);
337 return false;
338 }
339
340 FloatComplex tmp = float_complex_value ();
341 retval = H5Dwrite (data_hid, type_hid, octave_H5S_ALL, octave_H5S_ALL,
342 octave_H5P_DEFAULT, &tmp) >= 0;
343
344 H5Dclose (data_hid);
345 H5Tclose (type_hid);
346 H5Sclose (space_hid);
347
348 #else
349 octave_unused_parameter (loc_id);
350 octave_unused_parameter (name);
351
352 warn_save ("hdf5");
353 #endif
354
355 return retval;
356 }
357
358 bool
load_hdf5(octave_hdf5_id loc_id,const char * name)359 octave_float_complex::load_hdf5 (octave_hdf5_id loc_id, const char *name)
360 {
361 bool retval = false;
362
363 #if defined (HAVE_HDF5)
364
365 #if defined (HAVE_HDF5_18)
366 hid_t data_hid = H5Dopen (loc_id, name, octave_H5P_DEFAULT);
367 #else
368 hid_t data_hid = H5Dopen (loc_id, name);
369 #endif
370 hid_t type_hid = H5Dget_type (data_hid);
371
372 hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_FLOAT);
373
374 if (! hdf5_types_compatible (type_hid, complex_type))
375 {
376 H5Tclose (complex_type);
377 H5Dclose (data_hid);
378 return false;
379 }
380
381 hid_t space_id = H5Dget_space (data_hid);
382 hsize_t rank = H5Sget_simple_extent_ndims (space_id);
383
384 if (rank != 0)
385 {
386 H5Tclose (complex_type);
387 H5Sclose (space_id);
388 H5Dclose (data_hid);
389 return false;
390 }
391
392 // complex scalar:
393 FloatComplex ctmp;
394 if (H5Dread (data_hid, complex_type, octave_H5S_ALL, octave_H5S_ALL,
395 octave_H5P_DEFAULT, &ctmp)
396 >= 0)
397 {
398 retval = true;
399 scalar = ctmp;
400 }
401
402 H5Tclose (complex_type);
403 H5Sclose (space_id);
404 H5Dclose (data_hid);
405
406 #else
407 octave_unused_parameter (loc_id);
408 octave_unused_parameter (name);
409
410 warn_load ("hdf5");
411 #endif
412
413 return retval;
414 }
415
416 mxArray *
as_mxArray(void) const417 octave_float_complex::as_mxArray (void) const
418 {
419 mxArray *retval = new mxArray (mxSINGLE_CLASS, 1, 1, mxCOMPLEX);
420
421 float *pr = static_cast<float *> (retval->get_data ());
422 float *pi = static_cast<float *> (retval->get_imag_data ());
423
424 pr[0] = scalar.real ();
425 pi[0] = scalar.imag ();
426
427 return retval;
428 }
429
430 octave_value
map(unary_mapper_t umap) const431 octave_float_complex::map (unary_mapper_t umap) const
432 {
433 switch (umap)
434 {
435 #define SCALAR_MAPPER(UMAP, FCN) \
436 case umap_ ## UMAP: \
437 return octave_value (FCN (scalar))
438
439 SCALAR_MAPPER (abs, std::abs);
440 SCALAR_MAPPER (acos, octave::math::acos);
441 SCALAR_MAPPER (acosh, octave::math::acosh);
442 SCALAR_MAPPER (angle, std::arg);
443 SCALAR_MAPPER (arg, std::arg);
444 SCALAR_MAPPER (asin, octave::math::asin);
445 SCALAR_MAPPER (asinh, octave::math::asinh);
446 SCALAR_MAPPER (atan, octave::math::atan);
447 SCALAR_MAPPER (atanh, octave::math::atanh);
448 SCALAR_MAPPER (erf, octave::math::erf);
449 SCALAR_MAPPER (erfc, octave::math::erfc);
450 SCALAR_MAPPER (erfcx, octave::math::erfcx);
451 SCALAR_MAPPER (erfi, octave::math::erfi);
452 SCALAR_MAPPER (dawson, octave::math::dawson);
453 SCALAR_MAPPER (ceil, octave::math::ceil);
454 SCALAR_MAPPER (conj, std::conj);
455 SCALAR_MAPPER (cos, std::cos);
456 SCALAR_MAPPER (cosh, std::cosh);
457 SCALAR_MAPPER (exp, std::exp);
458 SCALAR_MAPPER (expm1, octave::math::expm1);
459 SCALAR_MAPPER (fix, octave::math::fix);
460 SCALAR_MAPPER (floor, octave::math::floor);
461 SCALAR_MAPPER (imag, std::imag);
462 SCALAR_MAPPER (log, std::log);
463 SCALAR_MAPPER (log2, octave::math::log2);
464 SCALAR_MAPPER (log10, std::log10);
465 SCALAR_MAPPER (log1p, octave::math::log1p);
466 SCALAR_MAPPER (real, std::real);
467 SCALAR_MAPPER (round, octave::math::round);
468 SCALAR_MAPPER (roundb, octave::math::roundb);
469 SCALAR_MAPPER (signum, octave::math::signum);
470 SCALAR_MAPPER (sin, std::sin);
471 SCALAR_MAPPER (sinh, std::sinh);
472 SCALAR_MAPPER (sqrt, std::sqrt);
473 SCALAR_MAPPER (tan, std::tan);
474 SCALAR_MAPPER (tanh, std::tanh);
475 SCALAR_MAPPER (isfinite, octave::math::isfinite);
476 SCALAR_MAPPER (isinf, octave::math::isinf);
477 SCALAR_MAPPER (isna, octave::math::isna);
478 SCALAR_MAPPER (isnan, octave::math::isnan);
479
480 // Special cases for Matlab compatibility
481 case umap_xtolower:
482 case umap_xtoupper:
483 return scalar;
484
485 default:
486 return octave_base_value::map (umap);
487 }
488 }
489